Harflerin Yerini Değiştir

[baydeniro]

Merhaba Arkadaşlar,
A2 hücresinde yazılı kelimenin harflerinin yerinin karıştırılması mümkün mü ?
PARÇAAl-L ve RASTGELE ile uzun formüüller kurarak yapılabiliyor ama makro ile daha hızlı bir yolu var mıdır acaba ?

 

[excelokyanus500]

Deneyin

Function KARISTIR(eski)
    On Error Resume Next
    n = Len(eski)
    yeni = ""
    Do
        i = Int(Rnd() * n) + 1
        c = Mid(eski, i, 1)
        If c <> "*" Then
            yeni = yeni & c
            eski = Replace(eski, c, "*", , 1)
        End If
    Loop Until Len(yeni) = n
    KARISTIR = yeni
End Function

Sub Kelime()
 son = Worksheets("Sayfa1").Range("A" & Rows.Count).End(xlUp).Row
 For Each c In Worksheets("Sayfa1").Range("A1:A" & son).Cells
 c.Offset(0, 1).Value = KARISTIR(c.Value)
 Next
End Sub

 

[baydeniro]

Deneyin

Function KARISTIR(eski)
    On Error Resume Next
    n = Len(eski)
    yeni = ""
    Do
        i = Int(Rnd() * n) + 1
        c = Mid(eski, i, 1)
        If c <> "*" Then
            yeni = yeni & c
            eski = Replace(eski, c, "*", , 1)
        End If
    Loop Until Len(yeni) = n
    KARISTIR = yeni
End Function

Sub Kelime()
son = Worksheets("Sayfa1").Range("A" & Rows.Count).End(xlUp).Row
For Each c In Worksheets("Sayfa1").Range("A1:A" & son).Cells
c.Offset(0, 1).Value = KARISTIR(c.Value)
Next
End Sub

excelokyanus500 üstadım mükemmel bir çalışma olmuş, elinize aklınıza sağlık. Harika çalışıyor. Sağolun var olun, sağlıcakla kalın

 

[Korhan Ayhan]

Bende hazırlamıştım. Foruma eklerken sanırım sorun oluştu.

 

[baydeniro]

Bende hazırlamıştım. Foruma eklerken sanırım sorun oluştu.

Korhan Ayhan çok çok teşekkür ediyorum, elinize, aklınıza sağlık. Harikulade bir KTF seçeneği oldu. Keyifle kullanacağım. Sağlıcakla kalın