Sesli - Sessiz Harf Ayırabilme

[gbm]

Bir hücre içerisindeki sesli ve sessiz harfleri ayırmak istiyorum. Bunun için de şöyle bir kod buldum:



Fakat kodu çalıştırdığımda hep bir önceki değerin üzerine ekleniyor.

Örn:
İlk başta "Excel" yazmış olayım, sesliler "ee" ve sessizler "xcl" olarak ayrılıyor, buraya kadar tamam.

Sonrasında "makro" yazarsam, sesliler "eeao" ve sessizler "xclmkr" şeklinde oluyor. Ben ise sadece "ao" ve "mkr" olsun istiyorum.



Bunu yapabilmek için yeni bir kod önerebilir misiniz? Ya da bu kodu nasıl güncellemeliyim?

Veya bunu kodsuz, daha basit şekilde fonksiyon ya da formüllerle yapabilme şansım var mı?

 

[gbm]

kodun yazılı halini de bırakayım

Option Explicit
Dim i As Single
Dim Dizi As String, Karakter As String * 1, Sessiz As String, Sesli As String

Sub DizidekiSesliSessizYazıKarakterleri()
On Error GoTo Hata
Dizi = Range("E3").Value
For i = 1 To Len(Dizi)
Karakter = VBA.Mid(Dizi, i, 1)
Select Case VBA.LCase(Karakter)
Case "a", "e", "ı", "i", "o", "ö", "u", "ü"
Sesli = Sesli & Karakter
Case Else
Sessiz = Sessiz + Karakter
End Select
Next i
Range("E16") = Sessiz
Range("E17") = Sesli
Exit Sub
Hata:
Range("E16") = ""
Range("E17") = ""
End Sub

 

[Haluk]

"Libre Office" de REGEX fonksiyonu kullanarak basit bir formülle yapabilirsiniz...








.

 

[gbm]

Excel üzerinden yapabileceğim bir şekli var mı acaba? Ya da Libre'deki değeri Excel'de direkt kullanabiliyor muyum?

"Libre Office" de REGEX fonksiyonu kullanarak basit bir formülle yapabilirsiniz...








.

 

[Haluk]

Libre Office'de kopyalayıp, MS Excel'e yapıştırabilirsiniz.

.

 

[Ali]

Kullanıcı tanımlı Fonksiyon

Function Karekterduz(aString As String, eslesen As String, _
                    Optional CaseSensitive As Boolean = False, Optional AlphaOnly As Boolean = True) As String
    Dim testString As String, testChr As String
    Dim i As Long
    testString = aString
    
    If Not CaseSensitive Then
        testString = LCase(testString)
        eslesen = LCase(eslesen)
    End If
    
    If Not eslesen Like "[?*]" Then
        eslesen = "[" & eslesen & "]"
    ElseIf eslesen = vbNullString Then
        eslesen = "*"
    End If
    
    For i = 1 To Len(testString)
        testChr = Mid(testString, i, 1)
        If testChr Like eslesen Then
            If AlphaOnly And (UCase(testChr) = LCase(testChr)) Then
            Else
                Karekterduz = Karekterduz & Mid(aString, i, 1)
            End If
        End If
    Next i

End Function

Sessiz harfler için

=Karekterduz(A1;"!aeiüıö")

Sesli harfler için

=Karekterduz(A1;"aeiüıö")

 

[Ali]

Başka bir kullanıcı tanımlı fonksiyon

Function Sesli(str As String) As String
Dim re As Object
Set re = CreateObject("vbscript.regexp")
re.IgnoreCase = True
re.Global = True
re.Pattern = "[bcçdfgğhjklmnpqrsştvwxyz]"
Sesli = re.Replace(str, "")
End Function

Function Sessiz(str As String) As String
Dim re As Object
Set re = CreateObject("vbscript.regexp")
re.IgnoreCase = True
re.Global = True
re.Pattern = "[aeiüıö]"
Sessiz = re.Replace(str, "")
End Function

=Sesli(A1)
=Sessiz(A1)

 

[gbm]

Çok teşekkür ederim herkese ellerinize sağlık. Bunu çalıştırabildim sağolun

Başka bir kullanıcı tanımlı fonksiyon

Function Sesli(str As String) As String
Dim re As Object
Set re = CreateObject("vbscript.regexp")
re.IgnoreCase = True
re.Global = True
re.Pattern = "[bcçdfgğhjklmnpqrsştvwxyz]"
Sesli = re.Replace(str, "")
End Function

Function Sessiz(str As String) As String
Dim re As Object
Set re = CreateObject("vbscript.regexp")
re.IgnoreCase = True
re.Global = True
re.Pattern = "[aeiüıö]"
Sessiz = re.Replace(str, "")
End Function

=Sesli(A1)
=Sessiz(A1)