Metni Belli Bir Karakterden Böl Ve Satır Satır Listele - Microsoft Excel

Tablodaki bir sütunda belli bir karakterle ayrılmış her satır için işlem yapar. Metni ilgili karakterden böler ve her metin parçasını verilen sütundaki ilk boş satıra yazdırır. Bunu yaparken de bölünmüş metnin sonuna ilk halinde karşılık gelen veriyi yazdırır.

Konu ile ilgili örnek bir veri setine aşağıdaki bağlantıdan ulaşabilirsiniz.

virgüllerle ayrılmış veriler içeren tablo veri seti

Option Explicit

Sub MetniBelliBirKarakterdenBolVeSatirSatirListele()
    Dim i     As Long
    Dim a     As Variant
    Dim j     As Long
    Dim sayac As Long
    
    sayac = 1
    
    For i = 1 To [A1048576].End(xlUp).Row
        a = Split(Range("B" & i), ",")
        
        If UBound(a) = 0 Then
            Range("C" & sayac) = Range("A" & i)
            Range("D" & sayac) = Range("B" & i)
            sayac = sayac + 1
        ElseIf UBound(a) > 0 Then
            For j = LBound(a) To UBound(a)
                Range("C" & sayac) = Range("A" & i)
                Range("D" & sayac) = Trim(a(j))
                sayac = sayac + 1
            Next
        End If
    Next
End Sub

Option Explicit

Sub MetniBelliBirKarakterdenBolVeSatirSatirListele()
    Dim i     As Long
    Dim a     As Variant
    Dim j     As Long
    Dim sayac As Long
    
    sayac = 1
    
    For i = 1 To [A1048576].End(xlUp).Row
        
        '--------------------------------------------------
        'Split() metodu ile hücredeki metini
        'virgüllerden bölüyoruz.
        '
        'a değişkeni dizi değişkeni gibi davranacak.
        '--------------------------------------------------
        a = Split(Range("B" & i), ",")
        
        '--------------------------------------------------
        'Eğer virgülle ayrılmış ifade yoksa çalışır.
        'Örneğin verinin tek bir karşılığı vardır,
        'bu yüzden de doğal olarak virgülle ayrılmamıştır.
        '--------------------------------------------------
        If UBound(a) = 0 Then
            Range("C" & sayac) = Range("A" & i)
            Range("D" & sayac) = Range("B" & i)
            sayac = sayac + 1
        
        ElseIf UBound(a) > 0 Then
        
            '--------------------------------------------------
            'Dizinin boyutu kadar çalışan bir döngü ile
            'virgül ile ayrılmış her ifadeyi yazdırıyoruz.
            '--------------------------------------------------
            For j = LBound(a) To UBound(a)
                Range("C" & sayac) = Range("A" & i)
                
                '--------------------------------------------------
                'Trim ile sağdaki soldaki gereksiz
                'boşlukları kaldırıyoruz.
                '--------------------------------------------------
                Range("D" & sayac) = Trim(a(j))
                sayac = sayac + 1
            Next
        End If
    Next
End Sub