Sesli ve Sessiz Harf Kurallarına Göre Renklendirme

[webliko]

Merhaba
İlk olarak böyle bir şey yapılabilir mi emin değilim kusura bakmayın. İçinde bir çok veri olan ve sürekli güncellenen bir liste var yaklaşık 30bin ile 50bin arasında değişiyor veriler. Ne yazık ki verilerde çok anlamsız kelimeler var random gibi. Mantıklı olanları bunların arasından ayırmam gerekiyor. O yuzden A sütünlarında bulunan kelimelerde

Kural 1: sesli harflerden 2 tanesi yanyana gelmeyecek
Kural 2: sessiz harflerden 3 tanesi yanyana gelmeyecek.

Yukarıdaki 2 kuraldan herhangi birine uymayan sutunlar renklendirilecek. Örnek Görsel



Şimdiden yardımlarınız için teşekkür ederim

 

[Muzaffer Ali]

Merhaba.

Dosyanız ekte.
VBA kodları ile yapılmıştır.
Kodları görmek için Sayfa adını sağ tıklatın, "Kod Görüntüle" seçin. "Module1" i açın.

Kodları buraya da ekliyorum.

Option Explicit
    Dim Sessiz() As Variant
    Dim Sesli() As Variant
    
Sub Test()
    Dim Say As Integer
    Dim Bak As Range
    Dim HarfBak As Integer
    Dim Harf As String
    Dim Harfler As String
    Sessiz = Array("b", "c", "d", "f", "g", "h", "j", "k", "l", "m", "n", "p", "r", "s", "ş", "t", "v", "y", "z")
    Sesli = Array("a", "e", "ı", "i", "o", "ö", "u", "ü")
    Say = Cells(Rows.Count, "A").End(3).Row
    Range("A2:A" & Say).Interior.Pattern = xlNone
    For Each Bak In Range("A2:A" & Say)
        For HarfBak = 2 To Len(Bak.Value)
            Harfler = Right(Left(Bak.Value, HarfBak), 2)
            If SesliHarf(Left(Harfler, 1)) And SesliHarf(Right(Harfler, 1)) Then
                Bak.Interior.Color = ColorConstants.vbCyan
                Exit For
            End If
        Next
        For HarfBak = 3 To Len(Bak.Value)
            Harfler = Right(Left(Bak.Value, HarfBak), 3)
            If SessizHarf(Left(Harfler, 1)) And SessizHarf(Right(Harfler, 1)) And SessizHarf(Left(Right(Harfler, 2), 1)) Then
                Bak.Interior.Color = ColorConstants.vbCyan
                Exit For
            End If
        Next
    Next
    MsgBox "İşlem tamamlandı.", vbInformation
End Sub

Function SessizHarf(Harf As String) As Boolean
    Dim Bak As Integer
    For Bak = 0 To UBound(Sessiz)
        If Sessiz(Bak) = Harf Then
            SessizHarf = True
            Exit For
        End If
    Next
End Function

Function SesliHarf(Harf As String) As Boolean
    Dim Bak As Integer
    For Bak = 0 To UBound(Sesli)
        If Sesli(Bak) = Harf Then
            SesliHarf = True
            Exit For
        End If
    Next
End Function

 

[webliko]

Hocam harika calısıyor gerçekten çok teşekkür ederim. Saygılar sevgiler.