Metinler her satırda aynı hizadan başlasın

[vitamin]

Arkadaşlar ekte excel çalışma örneği var.
Metinlerin her satırda aynı hizadan başlaması için bir makro rica ediyorum.

 

[vitamin]

Arkadaşlar yokmu bir makro veya formülü?

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub DÜZENLE()
    Dim X As Long, Y As Integer
    Dim KELİME
    Dim EN_BÜYÜK As Integer
    [B:IV].ClearContents
    For X = 2 To [A65536].End(3).Row
    KELİME = Split(Cells(X, 1), " ")
        For Y = 0 To UBound(KELİME)
        If Not IsNumeric(Left(KELİME(Y), 1)) Then
        If Cells(X, 256) = "" Then
        Cells(X, 256) = KELİME(Y)
        Else
        Cells(X, 256) = Cells(X, 256) & " " & KELİME(Y)
        End If
        Cells(X, 254) = Trim(Replace(Cells(X, 1), Cells(X, 256), ""))
        Cells(X, 255) = Len(Cells(X, 254))
        End If
        Next
    Next
    EN_BÜYÜK = WorksheetFunction.Max([IU:IU])
    If EN_BÜYÜK > 0 Then
    For X = 2 To [A65536].End(3).Row
    Cells(X, 2) = Cells(X, 254) & " " & WorksheetFunction.Rept(" ", (EN_BÜYÜK) - Len(Cells(X, 254))) & Cells(X, 256)
    Next
    End If
    [IT:IV].ClearContents
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[vitamin]

Korhan bey,
makroyu nasıl eklemem ve çalıştırmam gerektiğinide söyleyebilir misiniz?

İlginiz için teşekkürler.

 

[Korhan Ayhan]

Selamlar,

Dosyanızı açın. ALT+F11 tuşlarına basın. Kod editör sayfası açılacaktır.
Sağ üst köşede dosyanızın ismini bulup üzerinde sağ klik yapın. Açılan menüden INSERT-MODULE seçeneğini seçin. Boş bir pencere açılacaktır. Verdiğim kodu bu pencereye aktarın ve dosyanızı kaydedin.
ALT+F8 tuşlarına basın ve makroyu çalıştırın.

Not: Kod listelemeyi B sütununa yapmaktadır.

Eğer yapamazsanız ekteki dosyayı kullanabilirsiniz.

 

[vitamin]

Korhan Bey, ilginiz için tekrar teşekkür ederim.

Çok makbule geçti.

Bilgiler "E" sütununda olsa ve listeyi "F" sütununa almak istersek
makroda neyi değiştirmemiz gerekir acaba?

Teşekkürler, iyi çalışmalar.

 

[vitamin]

Arkadaşlar yok mu cevaplayacak?
Ek'deki makroyu "F" sütununa listeleyecek şekilde nasıl uyarlayabiliriz?

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki şekilde denermisiniz.

Option Explicit
 
Sub DÜZENLE()
    Dim X As Long, Y As Integer
    Dim KELİME
    Dim EN_BÜYÜK As Integer
    [F:IV].ClearContents
    For X = 2 To [E65536].End(3).Row
    KELİME = Split(Cells(X, 5), " ")
        For Y = 0 To UBound(KELİME)
        If Not IsNumeric(Left(KELİME(Y), 1)) Then
        If Cells(X, 256) = "" Then
        Cells(X, 256) = KELİME(Y)
        Else
        Cells(X, 256) = Cells(X, 256) & " " & KELİME(Y)
        End If
        Cells(X, 254) = Trim(Replace(Cells(X, 5), Cells(X, 256), ""))
        Cells(X, 255) = Len(Cells(X, 254))
        End If
        Next
    Next
    EN_BÜYÜK = WorksheetFunction.Max([IU:IU])
    If EN_BÜYÜK > 0 Then
    For X = 2 To [E65536].End(3).Row
    Cells(X, 6) = Cells(X, 254) & " " & WorksheetFunction.Rept(" ", (EN_BÜYÜK) - Len(Cells(X, 254))) & Cells(X, 256)
    Next
    End If
    [IT:IV].ClearContents
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[vitamin]

Koray bey,

Tekrar teşekkürler.