Verilen alandaki metinlerde büyük - küçük harf farketmeksizin "Ali" kelimelerinin sayısını bulan ve sonucunu veren regular expression örneğidir.
A sütununda aşağıdaki gibi bir liste var. Bu listenin içinde toplam kaç tane “Ali” kelimesi geçiyor. Büyük – küçük harf fark etmez.
Konu ile ilgili örnek bir veri setine aşağıdaki bağlantıdan ulaşabilirsiniz.
içinde "ali" metni geçen liste veri seti
Option Explicit
Sub AlandaAliKelimesininToplamSayisiniBul()
Dim i As Long
Dim sayac As Long
Dim regObj As Object
Dim aranan As String
Dim dizi() As Variant
ReDim dizi(0 To [A1048576].End(xlUp).Row - 1)
dizi = Application.Transpose(Range("A1:A6").Value)
Set regObj = CreateObject("VBScript.Regexp")
regObj.Pattern = "[Aa]li"
regObj.Global = True
aranan = "ali"
For i = LBound(dizi) To UBound(dizi)
Do While regObj.Test(dizi(i)) = True
sayac = sayac + 1
dizi(i) = Application.WorksheetFunction. _
Substitute(LCase(dizi(i)), aranan, "*", 1)
Loop
Next
Debug.Print sayac
End Sub
Option Explicit
Sub AlandaAliKelimesininToplamSayisiniBul()
Dim i As Long
Dim sayac As Long
Dim regObj As Object
Dim aranan As String
Dim dizi() As Variant
'--------------------------------------------------
'Dizinin sınırlarını belirledik.
'Bu kısım çok önemli, yoksa sağlam bir
'sinir harbi yaşatabiliyor.
'--------------------------------------------------
ReDim dizi(0 To [A1048576].End(xlUp).Row - 1)
'--------------------------------------------------
'Alandaki değerleri diziye aktardık.
'Bu döngü için işimize yarayacak.
'--------------------------------------------------
dizi = Application.Transpose(Range("A1:A6").Value)
'--------------------------------------------------
'Regexp kullanacağız, bunun için tanımladığımız
'object için regexp türünde bir instance oluşturduk.
'--------------------------------------------------
Set regObj = CreateObject("VBScript.RegExp")
'--------------------------------------------------
'Regexp için desenimizi tanımladık.
'--------------------------------------------------
regObj.Pattern = "[Aa]li"
'--------------------------------------------------
'Büyük küçük harf duyarlılığı olmasın.
'--------------------------------------------------
regObj.IgnoreCase = True
regObj.MultiLine = True
'--------------------------------------------------
'Tanımlanan desende eşleşen bütün ifadeleri
'buluyor. Eğer False yazsaydık ilk bulduğu
'yerde duracaktı.
'--------------------------------------------------
regObj.Global = True
'--------------------------------------------------
'Sayacı garanti olması için sıfırladık.
'--------------------------------------------------
sayac = 0
'--------------------------------------------------
'Aradığımız metni değişkene aktardık.
'--------------------------------------------------
aranan = "ali"
'--------------------------------------------------
'Bu döngüyü şunun için yaptım:
'Saydırmayı yaparken sayılanı elemek
'için silen kod yazdım. Silme işlemini
'alanda yapsın istemediğimden dolayı da
'diziye aktardım ve buradan yaptırıyorum.
'--------------------------------------------------
For i = LBound(dizi) To UBound(dizi)
'--------------------------------------------------
'Her hücre için eşleşmeler bitene kadar çalışacak.
'--------------------------------------------------
Do While regObj.Test(dizi(i)) = True
'--------------------------------------------------
'Eşleşme varsa sayacı 1 artır.
'--------------------------------------------------
sayac = sayac + 1
'--------------------------------------------------
'Şimdi eşleşmeyi bulduktan sonra o ifadeyi
'kaldıralım ki tekrar tekrar saymayalım.
'Bu yüzden o kelimeyi yıldız işareti ile
'değiştirdim.
'
'Aslında ilk başta hiçbir şey yazdırmıyordum
'ama şu senaryoda hatalı sayım yaptığından dolayı
'yıldız işaretine çevirdim:
'
'Listenin 6. maddesinde şu var: aiiiaaliliiliaw
'Ali kelimesi bunun neresinde? aiiia---ali---liiliaw
'Şimdi bu kelimeyi silelim: aiiialiiliaw
'
'Gördünüz mü? Bir Ali daha çıktı: aiii---ali---iliaw
'Halbuki orijinal kelimede sadece 1 Ali vardı.
'Bu yüzden böyle yaptım.
'--------------------------------------------------
dizi(i) = Application.WorksheetFunction. _
Substitute(LCase(dizi(i)), aranan, "*", 1)
Loop
Next
'--------------------------------------------------
'Immediate Window üzerine sonucu yazdırıyor.
'Ctrl + G kısayolu ile pencereyi VBA ekranında açabilirsiniz.
'--------------------------------------------------
Debug.Print sayac
End Sub