Türkçe karakterleri arama

[tamer42]

Merhaba,

Ağaıdaki kodda;
Türkçe karakterleri (İ , Ç, Ö, Ş, Ü, Ğ) aratırken, Türkçe ve İngilizce farketmetsizin aramayı nasıl yaptırabiliriz?

örnek C ve Ç yi aynı anda araması nasıl yapabiliriz?

X = "CA" yazdığımız zaman aynı anda "ÇA" olarakta arayacak
X = "ŞA" yazdığımız zaman aynı anda "SA" olarakta arayacak
X = "ÜL" yazdığımız zaman aynı anda "UL" olarakta arayacak
X = "OL" yazdığımız zaman aynı anda "ÖL" olarakta arayacak

Sub FindFromBeginning()
Dim X As Variant
Dim Position As Integer

X = "CA"

   Position = InStr(1, "Excel ÇA", X, vbBinaryCompare)

   MsgBox Position
 
End Sub

Teşekkürler,

iyi Çalışmalar.

 

[Ömer]

Merhaba,

Bu şekilde olabilir. Kullanım detayı net olmadığı için yazdığınızı varsayarak yaptım.

Sub FindFromBeginning()

    Dim X As Variant
    Dim Position As Integer
    Dim i As Byte

    X = Array("CA", "ÇA")
 
    For i = 0 To UBound(X)
        Position = InStr(1, "Excel ÇA", X(i), vbBinaryCompare)
        If Position <> 0 Then MsgBox Position
    Next i

End Sub

 

[Ömer]

Kullanım amacınıza göre bu şekilde de olabilir. Tek yazıma göre.

Sub FindFromBeginning()

    Dim X, trc, ing, deg, dizi()
    Dim Position As Integer
    Dim i As Byte, s As Byte
   
    X = "CA"

    ReDim Preserve dizi(s)
    dizi(s) = X
   
    ing = Array("I", "C", "O", "S", "U", "G")
    trc = Array("İ", "Ç", "Ö", "Ş", "Ü", "Ğ")
   
    For i = 0 To UBound(trc)
        deg = X
        X = Replace(X, ing(i), trc(i))
        If deg <> X Then s = 1
    Next i
   
    ReDim Preserve dizi(s)
    If s = 1 Then dizi(s) = X
   
    For i = 0 To UBound(dizi)
        Position = InStr(1, "Excel ÇA", dizi(i), vbBinaryCompare)
        If Position > 0 Then MsgBox Position
    Next i

End Sub

 

[tamer42]

Kullanım amacınıza göre bu şekilde de olabilir. Tek yazıma göre.

Sub FindFromBeginning()

    Dim X, trc, ing, deg, dizi()
    Dim Position As Integer
    Dim i As Byte, s As Byte
  
    X = "CA"

    ReDim Preserve dizi(s)
    dizi(s) = X
  
    ing = Array("I", "C", "O", "S", "U", "G")
    trc = Array("İ", "Ç", "Ö", "Ş", "Ü", "Ğ")
  
    For i = 0 To UBound(trc)
        deg = X
        X = Replace(X, ing(i), trc(i))
        If deg <> X Then s = 1
    Next i
  
    ReDim Preserve dizi(s)
    If s = 1 Then dizi(s) = X
  
    For i = 0 To UBound(dizi)
        Position = InStr(1, "Excel ÇA", dizi(i), vbBinaryCompare)
        If Position > 0 Then MsgBox Position
    Next i

End Sub

Teşekkürler Ömer Hocam
emeğinize sağlık