Harflar arası boşluk bırakma?

[balanar]

Merhaba

Ahmet Soycan
İbrahi Çapar
Sezen Kiptaş
Cafer Sadık Yıldı

gibi gibi bir isim listemiz var diyelim. İstediğim harfler arasına 1boşluk atma ortadaki boşluğuda 3boşluk attırmak istiyorum.

Örnek;

Ahmet Soycan = A h m e t(3boşluk)S o y c a n
Cafer Sadık Yıldı = C a f e r(3boşluk)S a d ı k(3boşluk)Y ı l d ı

 

[Muzaffer Ali]

Merhaba.
Yeni bir Kullanıcı Tanımlı Fonksiyon yazdım, bunu kullanarak yapabilirsiniz.

Dosyanıza yeni bir Module ekleyin aşağıdaki kodu Module kopyalayın.

Public Function BoşlukEkle(Metin As String) As String
    Dim Bak As Integer
    Dim YeniMetin As String
    For Bak = 1 To Len(Metin)
        If YeniMetin = "" Then
            YeniMetin = Left(Metin, 1)
        Else
            YeniMetin = YeniMetin & " " & Mid(Metin, Bak, 1)
        End If
    Next
    BoşlukEkle = YeniMetin
End Function

 

[veyselemre]

Function boslukEkle(txt As String) As String
    With CreateObject("Vbscript.Regexp")
        .Global = True
        .Pattern = "(.)"
        boslukEkle = Trim(.Replace(txt, "$1 "))
    End With
End Function

Sub boslukEkleme()
    With CreateObject("Vbscript.Regexp")
        .Global = True
        .Pattern = "(.)"
        For i = 1 To Cells(Rows.Count, 1).End(3).Row
            txt = Cells(i, 1).Value
            Cells(i, 2).Value = Trim(.Replace(txt, "$1 "))
        Next i
    End With
End Sub

Sub boslukEkleme2()
        For i = 1 To Cells(Rows.Count, 1).End(3).Row
            txt = Cells(i, 1).Value
            yeni = ""
            For ii = 1 To Len(txt)
                yeni = yeni & " " & Mid(txt, ii, 1)
            Next ii
            Cells(i, 4).Value = Mid(yeni, 2)
            'Cells(i, 4).Value = Trim(yeni)
        Next i
End Sub

 

[mehmetuca]

=PARÇAAL(YERİNEKOY(YERİNEKOY(A1;" ";"!");"!";"   ");1;1)&" "&PARÇAAL(A1;2;1)&" "&PARÇAAL(A1;3;1)&" "&PARÇAAL(A1;4;1)&" "&PARÇAAL(A1;5;1)&" "&PARÇAAL(A1;6;1)&" "&PARÇAAL(A1;7;1)&" "&PARÇAAL(A1;8;1)&" "&PARÇAAL(A1;9;1)&" "&PARÇAAL(A1;10;1)&" "&PARÇAAL(A1;11;1)&" "&PARÇAAL(A1;12;1)&" "&PARÇAAL(A1;13;1)&" "&PARÇAAL(A1;14;1)&" "&PARÇAAL(A1;15;1)&" "&PARÇAAL(A1;16;1)&" "&PARÇAAL(A1;17;1)&" "&PARÇAAL(A1;18;1)&" "&PARÇAAL(A1;19;1)&" "&PARÇAAL(A1;20;1)&" "&PARÇAAL(A1;21;1)&" "&PARÇAAL(A1;22;1)&" "&PARÇAAL(A1;23;1)&" "&PARÇAAL(A1;24;1)&" "&PARÇAAL(A1;25;1)

 

[mehmetuca]

=PARÇAAL(A1;1;1)&" "&PARÇAAL(A1;2;1)&" "&PARÇAAL(A1;3;1)&" "&PARÇAAL(A1;4;1)&" "&PARÇAAL(A1;5;1)&" "&PARÇAAL(A1;6;1)&" "&PARÇAAL(A1;7;1)&" "&PARÇAAL(A1;8;1)&" "&PARÇAAL(A1;9;1)&" "&PARÇAAL(A1;10;1)&" "&PARÇAAL(A1;11;1)&" "&PARÇAAL(A1;12;1)&" "&PARÇAAL(A1;13;1)&" "&PARÇAAL(A1;14;1)&" "&PARÇAAL(A1;15;1)&" "&PARÇAAL(A1;16;1)&" "&PARÇAAL(A1;17;1)&" "&PARÇAAL(A1;18;1)&" "&PARÇAAL(A1;19;1)&" "&PARÇAAL(A1;20;1)&" "&PARÇAAL(A1;21;1)&" "&PARÇAAL(A1;22;1)&" "&PARÇAAL(A1;23;1)&" "&PARÇAAL(A1;24;1)&" "&PARÇAAL(A1;25;1)

 

[Korhan Ayhan]

Microsoft 365 sürümü için alternatif;

=YERİNEKOY(METİNBİRLEŞTİR(" ";1;PARÇAAL(YERİNEKOY(A1;" ";"@");SATIR(DOLAYLI("1:"&UZUNLUK(YERİNEKOY(A1;" ";"@"))));1));"@";" ")

 

[Orion1]

Buyurun.
=YERİNEKOY(A1;" ";" ")

 

[Orion1]

Buyurun.
=YERİNEKOY(A1;" ";" ")

 

[Orion1]

Niye böyle oldu acaba!!
1 cevap yazdım 4 cevap olmuş!

 

[Korhan Ayhan]

Alternatif KTF;

Option Explicit

Function SPACE_TEXT(My_Range As Range) As String
    Dim My_Text() As Byte, My_Characters As Variant, Record_Counts As Long
    
    Application.Volatile True
    
    My_Text = StrConv(Replace(My_Range.Value, " ", "@"), vbFromUnicode)
    
    ReDim Letter_List(0 To UBound(My_Text))
    
    For Each My_Characters In My_Text
        Letter_List(Record_Counts) = Chr(My_Characters)
        Record_Counts = Record_Counts + 1
    Next

    SPACE_TEXT = Replace(Join(Letter_List, " "), "@", "   ")
End Function

 

[Korhan Ayhan]

@Orion1,

Siz çözüm öneriniz de hücredeki boşluğu yine boşluk karakteri ile değiştirmişsiniz. Üyemiz her harfin arasına boşluk ekleme talebinde bulunmuş. Ayrıca kelimelerin arasında bulunan boşluk karakter sayısınında 3 olmasını talep etmiş.