listeleme hk.

S

Ssu85

Katılım
20 Ocak 2018
Mesajlar
19
Excel Vers. ve Dili
Makro
makro çalışma kitabında olmayabilir ya da devre dışı olabilir diye uyarı geliyor. neden acaba söylediğiniz her aşamayı yaptım ama olmadı
 
S

Ssu85

Katılım
20 Ocak 2018
Mesajlar
19
Excel Vers. ve Dili
Makro
SON OLARAK BANA GÖNDERDİĞİNİZ KOD DA WATSONS YAZAN YERE O ÇIKARMAK İSTEDİĞİM FİRMANIN İSMİNİ Mİ YAZACAĞIM??? 3 AYRI YERDE
If Left(s3.Cells(i, "B"), 7) = "WATSONS" Then
GEÇİYOR BURDAKİ WATSONS YERİNE GERÇEK FİRMA ADINI MI YAZIYORUM
 
S

Ssu85

Katılım
20 Ocak 2018
Mesajlar
19
Excel Vers. ve Dili
Makro
https://www.dosyaupload.com/9pR9

ÖRNEK ÇALIŞMA LİNKİ ÜSTTEDİR.

BEN SİZİN GÖNDERDİĞİNİZ KODU DENEDİM TEŞEKKÜRLER OLDU İSTEDİĞİM AMA WATSONS YERİNE ASIL SİLMEK İSTEDİĞİM FİRMA ADINI YAZDIM OLMADI ASIL FİRMA ADI WATSONS DEĞİL "ESBAŞ"
BU ARADA SARI KIRMIZI RENKLENDİRME İŞLEMİ SÜPER OLMUŞ AYNI İSİMDE OLANLAR SİLİNMİŞ YENİLER KIRMIZI OLMUŞ
AMA BİR YENİ FİLTRELEME DAHA ÇIKTI BAŞIMA İÇİNDE OSGB GEÇENLERE DE YEŞİL RENKLENDİRME YAPILMASI.
SANIRIM BUNUN İÇİN YENİ KOD YAZILACAK

KISACASI VE AÇIKCASI ZAHMET OLMAZSA SİZDEN RİCAM:

Ekteki dosyada 3 ayrı sayfa var 2015, 2016 ve 2017 olmak üzere...
3 dosyada 2 sütun bulunmaktadır. Sütunlardan ilki tarih 2. sütunda kurum

1. işlem: Kurum sütununda aynı isime sahip olanların satırlarının silinmesi (Not: Yalnız burada bir handikap var mesela 2017 sayfasında hem GÜL BİJUTERİ var hem GÜL PARFÜMERİ aynı isime sahip olmaktan kastım içinde GÜL geçen satırların silmesi değil GÜL BİJUTERİ geçen satırların silinmesi)
2. işlem: Kurum sütununda ESBAŞ yazan tüm satırların silinmesi

1. ve 2. işlem hem 2015 hem 2016 hem de 2017 sayfası için yapılacak.

Listede bu temizleme işleminden sonra yapılacak olanlar ise:

3. işlem: 2015 sayfasında yer alan ASYA ECZANESİ 2016 sayfasında ve 2017 sayfasına geçiyor mu? (geçiyor ise o satır kırmızı olacak)
4.işlem: 2015 sayfasında yer alan (KALE ECZANESİ gibi) ancak 2016 ve 2017 sayfasında yer almayan firmaların satırlarının sarı olması
5. işlem: her sayfa için de sarıları ve kırmızıları filtreleme özelliğinin olması sadece kırmızıları göster ya da sarıları göster gibi bir filtreleme
YENİ İŞLEM İSE 2015-2016 VE 2017 DE İÇİN OSGB GEÇEN SATIRLARIN YEŞİL RENKTE OLMASI

RİCA ETSEM BUNU NASIL YAPABİLİRİM EKTE YENİ ÖRNEK DOSYA EKLEDİM. YAPTIĞINIZ KOD MÜKEMMEL İSTEDİĞİMİ YAPIYOR AMA SİLMEK İSTEDİĞİM WATSONS DEĞİL ESBAŞ
TÜMÜNE İLAVE OLARAK DA İÇİNDE OSGB GEÇEN SATIRLARI YEŞİL RENGE BOYAMASI

ÇOK ZAHMET VERDİM İLGİNİZE TEŞEKKÜR EDERİM
 
A

ataköylü-59

Katılım
1 Haziran 2014
Mesajlar
355
Excel Vers. ve Dili
Ofis 2010-Türkçe
Kod: 
Sub düzenle()
Set s1 = Sheets("2015")
Set s2 = Sheets("2016")
Set s3 = Sheets("2017")

eski15 = s1.Cells(Rows.Count, "B").End(3).Row
eski16 = s2.Cells(Rows.Count, "B").End(3).Row
eski17 = s3.Cells(Rows.Count, "B").End(3).Row

s1.Range("$A$1:$B$" & eski15).RemoveDuplicates Columns:=2, Header:=xlYes
s2.Range("$A$1:$B$" & eski16).RemoveDuplicates Columns:=2, Header:=xlYes
s3.Range("$A$1:$B$" & eski17).RemoveDuplicates Columns:=2, Header:=xlYes

yeni15 = s1.Cells(Rows.Count, "B").End(3).Row
yeni16 = s2.Cells(Rows.Count, "B").End(3).Row
yeni17 = s3.Cells(Rows.Count, "B").End(3).Row

s1.Activate
    For i = yeni15 To 2 Step -1
        If Left(s1.Cells(i, "B"), 5) = "ESBAŞ" Then
            s1.Rows(i).Delete shift:=xlUp
            GoTo 10
        Else
            If WorksheetFunction.CountIf(s2.Range("B1:B" & yeni16), s1.Cells(i, "B")) = 0 And _
                WorksheetFunction.CountIf(s3.Range("B1:B" & yeni17), s1.Cells(i, "B")) = 0 Then
                s1.Range("A" & i & ":B" & i).Interior.Color = vbYellow
            Else
                s1.Range("A" & i & ":B" & i).Interior.Color = vbRed
            End If
        End If
10:
    Next
s1.[B1].AutoFilter
s2.Activate
    For i = yeni16 To 2 Step -1
        If Left(s2.Cells(i, "B"), 5) = "ESBAŞ" Then
            s2.Rows(i).Delete shift:=xlUp
            GoTo 20
        Else
            If WorksheetFunction.CountIf(s1.Range("B1:B" & yeni15), s2.Cells(i, "B")) = 0 And _
                WorksheetFunction.CountIf(s3.Range("B1:B" & yeni17), s2.Cells(i, "B")) = 0 Then
                s2.Range("A" & i & ":B" & i).Interior.Color = vbYellow
            Else
                s2.Range("A" & i & ":B" & i).Interior.Color = vbRed
            End If
        End If
20:
    Next
s2.[B1].AutoFilter

s3.Activate
    For i = yeni17 To 2 Step -1
        If Left(s3.Cells(i, "B"), 5) = "ESBAŞ" Then
            s3.Rows(i).Delete shift:=xlUp
            GoTo 30
        Else
            If WorksheetFunction.CountIf(s1.Range("B1:B" & yeni15), s3.Cells(i, "B")) = 0 And _
                WorksheetFunction.CountIf(s2.Range("B1:B" & yeni16), s3.Cells(i, "B")) = 0 Then
                s3.Range("A" & i & ":B" & i).Interior.Color = vbYellow
            Else
                s3.Range("A" & i & ":B" & i).Interior.Color = vbRed
            End If
        End If
30:
    Next
s3.[B1].AutoFilter
End Sub
Sayın arkadaşım,
Aynı kodu silinmesini istediğiniz kelimeyi eşit olacak şekilde yazmamış olduğunuz için sonuç alamamış olmalısınız ben Yusuf beyin yazdığı kodu, ilgili kelimeyi değiştirerek yazdım. Yalnız kelime kaç harften oluşuyorsa onun evvelindeki rakamı da değiştirmelisiniz. bu kodu diğerini silerek yapıştırıp deneyin. Sanırım çalışır.
 
Son düzenleme:
S

Ssu85

Katılım
20 Ocak 2018
Mesajlar
19
Excel Vers. ve Dili
Makro
https://www.dosyaupload.com/9pR9

ÖRNEK ÇALIŞMA LİNKİ ÜSTTEDİR.

GÖNDERDİĞİNİZ KODU DENEDİM TEŞEKKÜRLER KISMEN OLDU İSTEDİĞİM AMA WATSONS YERİNE KODDA ASIL SİLMEK İSTEDİĞİM FİRMA ADINI YAZDIM AMA OLMADI


BU ARADA SARI KIRMIZI RENKLENDİRME İŞLEMİ SÜPER OLMUŞ ELİNİZE SAĞLIK AYNI İSİMDE OLANLAR SİLİNMİŞ YENİLER KIRMIZI OLMUŞ
AMA BİR YENİ FİLTRELEME DAHA ÇIKTI BAŞIMA İÇİNDE OSGB GEÇENLERE DE YEŞİL RENKLENDİRME YAPILMASI.
SANIRIM BUNUN İÇİN YENİ KOD YAZILACAK

KISACASI VE AÇIKCASI ZAHMET OLMAZSA SİZDEN RİCAM:



YENİ DOSYA LİNKİ: https://www.dosyaupload.com/9pR9

Ekteki dosyada TIPKI BİR ÖNCEKİ ÖRNEK DOSYA GİBİ 3 ayrı sayfa var 2015, 2016 ve 2017 olmak üzere...
3 dosyada 2 sütun bulunmaktadır. Sütunlardan ilki tarih 2. sütunda kurum

1. işlem: Kurum sütununda aynı isime sahip olanların satırlarının silinmesi (Not: Yalnız burada bir handikap var mesela 2017 sayfasında hem GÜL BİJUTERİ var hem GÜL PARFÜMERİ aynı isime sahip olmaktan kastım içinde GÜL geçen satırların silmesi değil GÜL BİJUTERİ geçen satırların silinmesi)
2. işlem: Kurum sütununda ESBAŞ yazan tüm satırların silinmesi

1. ve 2. işlem hem 2015 hem 2016 hem de 2017 sayfası için yapılacak.

Listede bu temizleme işleminden sonra yapılacak olanlar ise:

3. işlem: 2015 sayfasında yer alan ASYA ECZANESİ 2016 sayfasında ve 2017 sayfasına geçiyor mu? (geçiyor ise o satır kırmızı olacak)
4.işlem: 2015 sayfasında yer alan (KALE ECZANESİ gibi) ancak 2016 ve 2017 sayfasında yer almayan firmaların satırlarının sarı olması
5. işlem: her sayfa için de sarıları ve kırmızıları filtreleme özelliğinin olması sadece kırmızıları göster ya da sarıları göster gibi bir filtreleme

6. İŞLEM (İLAVE İSTEK) : 2015-2016 VE 2017 DE İÇİN OSGB GEÇEN SATIRLARIN YEŞİL RENKTE OLMASI

ZAHMET VERİYORUM AMA LÜTFEN YARDIMCI OLUN YARIN BU DOSYA GELDİĞİNDE YAPMAM GEREKLİ VE BEN NASIL OLACAĞINI BİLMİYORUM SİZİN GÖNDERDİĞİNİZ KOD ÖRNEK ÇALIŞMA ÜZERİNDEN İSTEDİĞİMİ YAPTI AMA GERÇEK DOSYA İÇİN KODU DEĞİŞTİRDİM (ÖRNEK DOSYADA YAZAN WATSONS YERİNE ESBAŞ YAZDIM) AMA OLMADI

AYRICA İLAVE İSTEK DE GELDİ İÇİNDE OSGB GEÇEN SATIRLARIN YEŞİL RENKTE OLMASI



YORUYORUM AMA YARDIM BEKLİYORUM
 
S

Ssu85

Katılım
20 Ocak 2018
Mesajlar
19
Excel Vers. ve Dili
Makro
Esbaş konusu ok. çok teşekkür ederim oldu aslında ilave bir işlemden daha bahsetmiştim bu gönderdiğiniz kod işimi görüyor ama benden aynı excell çalışma dosyasında birşey daha istediler içinde osgb geçen satırlarında yeşil renkte olması filtrede özel sırlama kısmına yeşil renkte gelecek yani
çok oluyorum ama bunuda ekleyebilir misiniz gönderdiğiniz koda???????
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,071
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Sayın ataköylü'nün belirttiği gibi koşullu biçimlendirme ile yapabilirsiniz. Ko ile yapmak için aşağıdaki makroyu deneyin:

Kod: 
Sub düzenle()
Set s1 = Sheets("2015")
Set s2 = Sheets("2016")
Set s3 = Sheets("2017")

eski15 = s1.Cells(Rows.Count, "B").End(3).Row
eski16 = s2.Cells(Rows.Count, "B").End(3).Row
eski17 = s3.Cells(Rows.Count, "B").End(3).Row

s1.Range("$A$1:$B$" & eski15).RemoveDuplicates Columns:=2, Header:=xlYes
s2.Range("$A$1:$B$" & eski16).RemoveDuplicates Columns:=2, Header:=xlYes
s3.Range("$A$1:$B$" & eski17).RemoveDuplicates Columns:=2, Header:=xlYes

yeni15 = s1.Cells(Rows.Count, "B").End(3).Row
yeni16 = s2.Cells(Rows.Count, "B").End(3).Row
yeni17 = s3.Cells(Rows.Count, "B").End(3).Row

s1.Activate
    For i = yeni15 To 2 Step -1
        If Left(s1.Cells(i, "B"), 5) = "ESBAŞ" Then
            s1.Rows(i).Delete shift:=xlUp
            GoTo 10
        Else
            If WorksheetFunction.CountIf(s2.Range("B1:B" & yeni16), s1.Cells(i, "B")) = 0 And _
                WorksheetFunction.CountIf(s3.Range("B1:B" & yeni17), s1.Cells(i, "B")) = 0 Then
                s1.Range("A" & i & ":B" & i).Interior.Color = vbYellow
            Else
                s1.Range("A" & i & ":B" & i).Interior.Color = vbRed
            End If
        End If
        If Len(Replace(s1.Cells(i, "B"), "OSGB", "")) <> Len(s1.Cells(i, "B")) Then
            s1.Range("A" & i & ":B" & i).Interior.Color = vbGreen
        End If
            
10:
    Next
s1.[B1].AutoFilter
s2.Activate
    For i = yeni16 To 2 Step -1
        If Left(s2.Cells(i, "B"), 5) = "ESBAŞ" Then
            s2.Rows(i).Delete shift:=xlUp
            GoTo 20
        Else
            If WorksheetFunction.CountIf(s1.Range("B1:B" & yeni15), s2.Cells(i, "B")) = 0 And _
                WorksheetFunction.CountIf(s3.Range("B1:B" & yeni17), s2.Cells(i, "B")) = 0 Then
                s2.Range("A" & i & ":B" & i).Interior.Color = vbYellow
            Else
                s2.Range("A" & i & ":B" & i).Interior.Color = vbRed
            End If
        End If
        If Len(Replace(s2.Cells(i, "B"), "OSGB", "")) <> Len(s2.Cells(i, "B")) Then
            s2.Range("A" & i & ":B" & i).Interior.Color = vbGreen
        End If
20:
    Next
s2.[B1].AutoFilter

s3.Activate
    For i = yeni17 To 2 Step -1
        If Left(s3.Cells(i, "B"), 5) = "ESBAŞ" Then
            s3.Rows(i).Delete shift:=xlUp
            GoTo 30
        Else
            If WorksheetFunction.CountIf(s1.Range("B1:B" & yeni15), s3.Cells(i, "B")) = 0 And _
                WorksheetFunction.CountIf(s2.Range("B1:B" & yeni16), s3.Cells(i, "B")) = 0 Then
                s3.Range("A" & i & ":B" & i).Interior.Color = vbYellow
            Else
                s3.Range("A" & i & ":B" & i).Interior.Color = vbRed
            End If
        End If
        If Len(Replace(s3.Cells(i, "B"), "OSGB", "")) <> Len(s3.Cells(i, "B")) Then
            s3.Range("A" & i & ":B" & i).Interior.Color = vbGreen
        End If

30:
    Next
s3.[B1].AutoFilter
End Sub
 
S

Ssu85

Katılım
20 Ocak 2018
Mesajlar
19
Excel Vers. ve Dili
Makro
Tamam yeni gonderdiginiz kodu deneyeceğim
Çok teşekkür ederim
 
N

nongeyikm

Altın Üye
Katılım
7 Kasım 2005
Mesajlar
505
Excel Vers. ve Dili
Office 365 TR-64
Altın Üyelik Bitiş Tarihi
15-04-2025
Ömer Bey merhaba,

Çok teşekkür ediyorum.
Kolay gelsin,
 
N

nongeyikm

Altın Üye
Katılım
7 Kasım 2005
Mesajlar
505
Excel Vers. ve Dili
Office 365 TR-64
Altın Üyelik Bitiş Tarihi
15-04-2025
listelemede ve kopyalamada ağırlaşma/donma

Ömer Bey merhaba,

Çalışmanızı başarılı bir şekilde kullanıyorum. Sayfa sayısı arttıkça listelemede ve kopyalamada ciddi ağırlaşmalar oldu. Listeleme yarım saati bulabiliyor. Ayrıca B sütundaki hücrelerden boş olan var ise o satırı listelemesin. İnceleyebilirmisiniz ?

Saygılarımla,
 

Ekli dosyalar

Ö

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Merhaba.

"B sütundaki hücrelerden boş olan var ise o satırı listelemesi" şeklindeki cümleniz pek anlamlı gelmedi bana.

Verdiğim kod sırasıyla;
-- sayfalardaki B12:E86 hücre aralıklarındaki verileri (geçici olarak) İCMAL sayfası YA:YD sütun aralığına alıyor,
-- YA:YD sütununda sıralayıp mükerrerleri temizledikten sonra kalan bilgileri, İCMAL sayfası B12:E86 aralığına yazıyor,
-- bu veriler için tek tek, diğer sayfalarda arama/sayma işlemini yapıyor ve bulunan değerleri X sayısı veya toplam olarak İCMAL sayfası ilgili satır/sütuna yazıyor.

Ben kodda bir sorun göremiyorum.

Yanlış işlem yaptığını düşündüğünüz bir örnek belge yükleyip,
bu örnek belgede de; şu hücrede şu olması gerektiği halde şunu yazdı gibi,
sayfa adı/hücre adresi belirterek hatalı olduğunu düşündüğünüz sonucu ve neden yanlış olduğunu net şekilde açıklayın.
.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst