Bir sonraki harf ile değiştirme

[xyiskarx]

Arkadaşlar Acil Olarak Yardımınızı İstiyorum...
Mesela A1 sütununda "Yavuz" Diye Bir Metin Var Ben Bunu İki Harf Ötelenmiş Halde B1 De Görmek İstiyorum Bunun Formülü Nedir?

Örnek: A1: YAVUZ =Bu Yazı B2de: ZBYÜA Bu hale gelecek bu bir harf ötelenmiş hali

 

[xyiskarx]

Yok Mu Yardım Edebilecek Biri?

 

[Korhan Ayhan]

Başlığınız forum kurallarına uygun olmalıdır.

Bu sebeple cevap alamıyor olabilirsiniz.

 

[Muhammet Okumuş]

Formüllü çözüm nasıldır bilmiyorum. Kod işinize yarayacaksa

Sub Ötele()
On Error Resume Next
x = Len(Range("C1"))
For i = 1 To x
a = WorksheetFunction.VLookup(Mid(Range("C1"), i, 1), Range("A1:B29"), 2, 0)
b = b & a
Next
Range("C2") = b
End Sub

deneyiniz.
A1:A29 ABC...VYZ şeklinde
B1:B29 aralığına BCD ... YZA şeklinde yazınız.

C1 hücresine kelimenizi yazınız. Kod çevrilmiş halini C2ye yaar.

 

[Ömer]

Merhaba,

[Düzeltme: Muhammet bey'in verdiği örnekte aynı işlemi yapıyor. Alternatif olsun. ]

Kodları Module yapıştırın. Daha sonra herhangi bir hücreye; =Cevir(hücre_adresi) yazınız.

=Cevir(A1) gibi.

Function Cevir(hcr)
    
    Dim j As Byte, a As Byte, s1(), s2(), k As Byte, d, deg
    
    s1 = Array("c", "C", "g", "G", "ı", "I", "o", "O", "s", "S", "u", "U", "z", "Z", "p", "P", "v", "V", "h")
    s2 = Array("ç", "Ç", "ğ", "Ğ", "i", "İ", "ö", "Ö", "ş", "Ş", "ü", "Ü", "a", "A", "r", "R", "y", "Y", "ı")

    For j = 1 To Len(hcr)
        a = 0
        deg = Mid(hcr, j, 1)
        If Asc(Mid(hcr, j, 1)) = 32 Then
            d = d & " "
        Else
            For k = 0 To UBound(s1)
                If deg = s1(k) Then
                    d = d & s2(k)
                    a = 1
                    Exit For
                End If
            Next k
            If a = 0 Then
                If Asc(deg) + 1 > 122 Then
                    For k = 0 To UBound(s1)
                        If deg = s2(k) Then
                            d = d & Chr(Asc(s1(k)) + 1)
                            a = 1
                            Exit For
                        End If
                    Next k
                Else
                    d = d & Chr(Asc(deg) + 1)
                End If
            End If
        End If
    Next j
    Cevir = d
        
End Function

.