makro ile eğersay ve eğer kombinasyonu

[kombo]

Makro kaydet ile yaptığım

ActiveCell.FormulaR1C1 = _
        "=IF(COUNTIF(R4C2:RC[-1],""*""&R2C4&""*"")>COUNTIF(R3C3:R[-1]C,"">0""),COUNTIF(R4C2:RC[-1],""*""&R2C4&""*""),"""")"
Range("C4").Select
    Selection.AutoFill Destination:=Range("C4:C3000")

Kodu nasıl kısaltabilirim.
Formül şöyle;
=EĞER(EĞERSAY($B$4:B4;"*"&$D$2&"*")>EĞERSAY($C$3:C3;">0");EĞERSAY($B$4:B4;"*"&$D$2&"*");"")
ve 3000 satır aşağıya doğru kopyalıyorum.

 

[Seyit Tiken]

Kodu kendinize uyarlayınız.

Sub Düğme1_Tıklat()
[A1] = "=IF(COUNTIF(R4C2:R[3]C[1],""*""&R2C4&""*"")>COUNTIF(R3C3:R[2]C[2],"">0""),COUNTIF(R4C2:R[3]C[1],""*""&R2C4&""*""),"""")"
[A1].AutoFill Destination:=[A1:A100]
End Sub

 

[Korhan Ayhan]

Selamlar,

Alternatif olarak kodu biraz daha kısaltarak aşağıdaki şekilde de kullanabilirsiniz.

Sub FORMÜL_UYGULA()
    [C4:C3000] = "=IF(COUNTIF($B$4:B4,""*""&$D$2&""*"")>COUNTIF($C$3:C3,"">0""),COUNTIF($B$4:B4,""*""&$D$2&""*""),"""")"
End Sub

 

[kombo]

Sn. Seyit Tiken
Sn. COST_CONTROL

Geri dönüşüm için geç kaldım özür dilerim. İlginiz için teşekkür ederim.
Dosyayı açınca böyle bir soru sorduğum aklıma geldi.
Konuyla ilgili yeni bir soru soracağım.

Sub bul()
Application.EnableEvents = False
For x = [B65536].End(3).Row To 2 Step -1
If Cells(x, 1) = (" * " & [d2] & " * ") Then Cells(x, 2) = "x"
Next
Application.EnableEvents = True
End Sub

Yapmak istediğim D2 hücresinde yazan veriyi B sütununda aramak ve renklendirmek. Yukardaki kodlarlarla öncelikle arama işlemini yapmaya çalışıyorum. daha sonra renklendirmeye kafa yoracağım.
Yukardaki mesajlarımda yazdığım formülasyonla işlemi yapıyorum ve Koşullu biçimlendirme ile renklendiriyorum ama B sütunundaki veri 3000 satırı geçince çalışması zaman alıyor.
İşin püf noktası D2 hücresindeki veri ile B sütununda ki veri birebir aynı değil. Yani bir cümle içinde geçen kelime gibi. Onun için
"*"&D2&"*"
gibi bir ifade ile eğersayla bulabiliyorum. Bu ifadeyi makro içinde nasıl yazabilirim. Deniyorum ama bir türlü başaramadım.

 

[Korhan Ayhan]

Selamlar,

Bu işlemi aşağıdaki kodlar ile yapabilirsiniz. Umarım faydası olur.

1. Kod büyük-küçük harf duyarlıdır.

Sub BUL_RENKLENDİR()
    Columns("B:B").Interior.ColorIndex = xlNone
    For Each HÜCRE In Range("B2:B" & [B65536].End(3).Row)
    If HÜCRE Like "*" & [D2] & "*" Then HÜCRE.Interior.ColorIndex = 6
    Next
End Sub

2. Kod büyük-küçük harf duyarlı değildir.

Sub BUL_RENKLENDİR()
    Columns("B:B").Interior.ColorIndex = xlNone
    For Each HÜCRE In Range("B2:B" & [B65536].End(3).Row)
    VERİ = UCase(Replace(Replace(HÜCRE, "ı", "I"), "i", "İ"))
    KRİTER = UCase(Replace(Replace([D2], "ı", "I"), "i", "İ"))
    If VERİ Like "*" & KRİTER & "*" Then HÜCRE.Interior.ColorIndex = 6
    Next
End Sub

 

[kombo]

Sn COST_CONTROL

İlginiz için teşekkür ederim.

Yazdığınız makro çalışmadı. Daha doğrusu çalıştı ama bütün B sütunu renklendi..

 

[Korhan Ayhan]

Selamlar,

Sn. kombo,

Örnek dosya ekleyebilirmisiniz.

 

[kombo]

Sn COST_CONTROL

Linki verecektim ama bulamadım. Burada sorulmuş cevapsız kalmış bir soru idi. Üzerinde çalıştığım uzun sürede işlem yapan dosyayı gönderiyorum. Bende birşeyler öğrenirim bu arada.
NOT..........
Linki buldum. Kurallara uymayan başlıklara taşınmış. Soru şöyle:

yurt genelinde üniversitelerin belirli fakültelerine afiş vs göndermemiz gerekiyor. elimde yurt genelindeki bütün fakültelerin olduğu bi liste var. bana lazım olan fakültelerin sayısını nasıl bulabilirim. yardımcı olursanız sevinirim. örnek olarak "eğitim fakültesi" kaç tane var. yardımınız için şimdiden teşekkürler

 

[Korhan Ayhan]

Selamlar,

Sn. kombo,

Eklemiş olduğunuz örnek dosyanın B sütununa KOŞULLU BİÇİMLENDİRME uygulanmış. B sütununu seçip koşullu biçimlendirmeyi sildikten sonra aşağıdaki kodu çalıştırırsanız renklendirmenin yapıldığını göreceksiniz.

Sub BUL_RENKLENDİR()
    Columns("B:B").Interior.ColorIndex = xlNone
    For Each HÜCRE In Range("B2:B" & [B65536].End(3).Row)
    VERİ = UCase(Replace(Replace(HÜCRE, "ı", "I"), "i", "İ"))
    KRİTER = UCase(Replace(Replace([D2], "ı", "I"), "i", "İ"))
    If VERİ Like "*" & KRİTER & "*" Then HÜCRE.Interior.ColorIndex = 6
    Next
End Sub

 

[kombo]

Sn COST_CONTROL

Sizin kodlarınızı yazınca koşullu biçimlendirmeyi iptal etmemiştim. Hiç aklıma da gelmedi. Şimdi çok süper oldu. Bu sayede bende birşeyler öğrenmeye çalışıyorum.
İlginiz için tekrar teşekkür ederim.