Kelimeler Arasına Boşluk Verme

[beyaz34]

Elimdeki verilerde hiç boşluk bırakılmadan bazılmış.
Her kelime asına boşluk vereçek makroya ihtiyacım var.

Başlık Taki Gibi Olmasını İştiyorum.

 

[Korhan Ayhan]

Selamlar,

Bu verilere göre istediğiniz işlemin yapılması zor görünüyor.

 

[leumruk]

Merhaba,
Tam olmasa da isteğinizi büyük ölçüde karşılayacak bir kod üretmeye çalıştım. Aşağıdaki kodu bir butona atayıp çalıştırınız.

Sub Ayir()
Hrf = Array("A", "B", "C", "Ç", "D", "E", "F", "G", "Ğ", "H", "I", "İ", "J", "K", "L", "M", "N", "O", "Ö", "P", "R", "S", "Ş", "T", "U", "Ü", "V", "Y", "Z")
Application.ScreenUpdating = False
For x = 1 To [a65536].End(3).Row
For y = Len(Cells(x, "a")) To 1 Step -1
    deg = Mid(Cells(x, "a"), y, 1)
    Say = Say + 1
    For z = LBound(Hrf) To UBound(Hrf)
        If deg = Hrf(z) Then
        klm = Mid(Cells(x, "a"), y, Say) & " " & klm
        Say = 0
        End If
    Next
Next
Cells(x, "c") = klm
klm = ""
Next
End Sub

 

[beyaz34]

Merhaba,
Tam olmasa da isteğinizi büyük ölçüde karşılayacak bir kod üretmeye çalıştım. Aşağıdaki kodu bir butona atayıp çalıştırınız.

Sub Ayir()
Hrf = Array("A", "B", "C", "Ç", "D", "E", "F", "G", "Ğ", "H", "I", "İ", "J", "K", "L", "M", "N", "O", "Ö", "P", "R", "S", "Ş", "T", "U", "Ü", "V", "Y", "Z")
Application.ScreenUpdating = False
For x = 1 To [a65536].End(3).Row
For y = Len(Cells(x, "a")) To 1 Step -1
    deg = Mid(Cells(x, "a"), y, 1)
    Say = Say + 1
    For z = LBound(Hrf) To UBound(Hrf)
        If deg = Hrf(z) Then
        klm = Mid(Cells(x, "a"), y, Say) & " " & klm
        Say = 0
        End If
    Next
Next
Cells(x, "c") = klm
klm = ""
Next
End Sub

Hocam eline koluna sağlık güzel olmuş tesekkürler......

 

[leumruk]

Hocam eline koluna sağlık güzel olmuş tesekkürler......

Rica ederim.