Harfleri karıştırma

[aslıı1298]

Merhaba iyi aksamlar,
Bir hücreye yazdığım yazıyı farklı hücrelere harf harf rassal olarak atamayı nasıl yapabilirim?
yani A3 hücresine yazdığım KALEM sözcüğünü C14=L,D14=A,E14=E vb gelecek şekilde nasıl kodlayabilirim?

 

[ÖmerFaruk]

Sub HarfBul()
Dim Kelime As String, bak As String
Dim uzunluk As Integer, say As Integer, Sütun As Integer
    Kelime = Range("A3")
    uzunluk = Len(Range("A3"))
    say = 3
    
    Do
        Cells(14, say) = ""
        say = say + 1
    Loop Until Cells(14, say) = ""
 
    Sütun = 3
    bak = Kelime
    
    Do
        Randomize
        say = WorksheetFunction.RandBetween(1, uzunluk)
        bak = Left(Kelime, say - 1) & 1 & Right(Kelime, uzunluk - say)
        If bak <> Kelime Then
            Cells(14, Sütun) = Mid(Range("A3"), say, 1)
            Kelime = bak
            Sütun = Sütun + 1
        End If
    Loop Until Sütun - 3 = uzunluk
End Sub

 

[Saban Sertkaya]

Alternatif olsun.

Lütfen sorularınızı örnek dosya ekleyerek sorunuz.

Aşağıdaki kodu deneyiniz. Yazılan kelimeden 3 harfi rastgele atar.

Sub Düğme1_Tıklat()
Randomize
[C14:E14] = ""
a = Int(Rnd * Len([A3])) + 1
[C14] = Mid([A3], a, 1)

10
b = Int(Rnd * Len([A3])) + 1
[D14] = Mid([A3], b, 1)
If [D14] = [C14] Then GoTo 10

20
c = Int(Rnd * Len([A3])) + 1
[E14] = Mid([A3], c, 1)
If [E14] = [C14] Or [E14] = [D14] Then GoTo 20
End Sub