Find All İşlevini Makro İle Yapmak

[baydeniro]

Merhaba arkadaşlar. Find All işlevini makro ile yapmak mümkün mü ? Makro sihirbazı ile denedim. Kayıt ederken yapıyor ama makroyu çalıştırınca yapmıyor.

Ekteki dosyada örnek bir çalışma var. Sonuçta işlemin sonunda A4, B10 ve C20 hücreleri seçili olmalı.

Not : Örnekteki Find işlevi Font özellikli bir aramayla ilgilidir.

 

[Ferhat Pazarçevirdi]

Aşağıdakileri, standart bir modul sayfasına kopyalayınız ve sayfadaki butona atayarak çalıştırınız.

Sub Renkli_Hucre_Bul()
Dim aralik As Range
Dim bul As Range
Dim bulunanlar As Range
Dim adres As String
With Application.FindFormat.Font
        .ColorIndex = 3               [COLOR=green]'İsterseniz diğer özellikleri de ekleyebilirsiniz.[/COLOR]
[COLOR=green]'       .Bold = True[/COLOR]                  [COLOR=green]'Şu an sadece font rengi kırmızı olanlar bulunuyor[/COLOR]
[COLOR=green]'       .Italic = True[/COLOR]
[COLOR=green]'       .Size = 16[/COLOR]
End With
Set aralik = Range("A2:C30")
Set bul = aralik.Find(What:="", SearchFormat:=True)
If Not bul Is Nothing Then
   Set bulunanlar = bul
   adres = bul.Address
 
   Do
        Set bulunanlar = Application.Union(bulunanlar, bul)
        Set bul = aralik.Find(What:="", after:=bul, SearchFormat:=True)
 
   Loop While Not bul Is Nothing And bul.Address <> adres
   If Not bulunanlar Is Nothing Then
        bulunanlar.Select
   End If
End If
End Sub

 

[baydeniro]

Teşekkürler

Sayın Ferhat Pazarçevirdi, yardımlarınız için çok çok teşekkürler.