Hücrelerdeki birçok verinin satırlara aktarılması

[mehmetmet]

Merhaba,

Örnek olarak ek yaptığım listede virgülle ayrılmış verileri tek tek hücrelere almak istiyorum. örnek listeyi ve olmasını istediğim şekli örnek olarak excelde oluşturdum.

Teşekkürler...

 

[Ziynettin]

Merhaba,
.....
Deneyiniz.....
.....

Option Explicit
Sub ayir()
Dim s1 As Worksheet, s2 As Worksheet, a(), b(), c, d
Dim i As Long, x As Byte, Say As Long, Sat_top As Double
Set s1 = Sheets("VERİLER"): Set s2 = Sheets("OLMASI BEKLENEN")
a = s1.Range("A1:B" & s1.Cells(Rows.Count, 1).End(xlUp).Row)
    For i = 1 To UBound(a)
        c = Split(a(i, 1), ",")
        Sat_top = Sat_top + UBound(c) + 1
    Next i
ReDim b(1 To Sat_top, 1 To 2)
    For i = 1 To UBound(a)
        c = Split(a(i, 1), ",")
        d = Split(a(i, 2), ", ")
        For x = 0 To UBound(c)
            Say = Say + 1
            b(Say, 1) = Trim(c(x))
            b(Say, 2) = d(x)
        Next x
    Next i
s2.Range("A:B").ClearContents
If Say > 0 Then
    s2.[A1].Resize(Say, 2) = b
End If
MsgBox "İşlem Tamam.", vbInformation
End Sub

 

[mehmetmet]

Merhaba,

Kodu denedim ve sorunsuz çalıştı. Elinize sağlık, çok teşekkürler..