Veri Ayır

[Muhammet Okumuş]

Merhaba arkadaşlar. Tek hücredeki karışık veriyi satır ve sütunlara ayırmak istiyorum. Dosyada daha net anlaşılıyor. Cevaplarınız için şimdiden teşekkür ederim.

 

[Ömer BARAN]

Merhaba.

Aşağıdaki kod'u dener misiniz?
İç içe Split komutuyla da çözülebilirdi sanırım ama sütunlara ayırma kolayıma geldi.
NOT: Kod, H sütunundan itibaren sağa doğru 1'inci satırı kullanıyor, bu alanda veri varsa başka bir konuma alınız.

Sub AYRISTIR_BRN()
Application.ScreenUpdating = False
[B1:F1].UnMerge: b2 = "no"
If Cells(Rows.Count, 3).End(3).Row > 2 Then Range("B3:F" & Rows.Count).ClearContents
If Cells(1, Columns.Count).End(xlToLeft).Column > 6 Then Range("G1:IV1").ClearContents
[B1].TextToColumns Destination:=[H1], DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, Semicolon:=True, Comma:=False, Space:=False, Other:=False
Application.DisplayAlerts = False
For sut = 8 To Cells(1, Columns.Count).End(xlToLeft).Column
    sat = Cells(Rows.Count, 2).End(3).Row + 1
    Cells(sat, 2) = Replace(Cells(1, sut), " ", "")
    Cells(sat, 2).TextToColumns Destination:=Cells(sat, 3), _
                    DataType:=xlDelimited, Other:=True, OtherChar:="-"
        If Len(Cells(sat, 3)) <> Len(Replace(Cells(sat, 3), ")", "")) Then
            ilk = WorksheetFunction.Search("(", Cells(sat, 3))
            Cells(sat, 5) = Replace(Mid(Cells(sat, 3), ilk + 1, 255), ")", "")
            Cells(sat, 3) = Mid(Cells(sat, 3), 1, ilk - 1)
        End If
        If Len(Cells(sat, 4)) <> Len(Replace(Cells(sat, 4), ")", "")) Then
            ilk = WorksheetFunction.Search("(", Cells(sat, 4))
            Cells(sat, 6) = Replace(Mid(Cells(sat, 4), ilk + 1, 255), ")", "")
            Cells(sat, 4) = Mid(Cells(sat, 4), 1, ilk - 1)
        End If
    Cells(sat, 2) = sut - 7
Next
Application.DisplayAlerts = True
If Cells(1, Columns.Count).End(xlToLeft).Column > 6 Then Range("G1:IV1").ClearContents
[B1:F1].Merge: Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı.", vbInformation, "..:: Ömer BARAN ::.."
End Sub

 

[Muhammet Okumuş]

Ömer Bey cevabınız için teşekkür ederim. Kod sonuca götürüyor. Kodunuzu yarın detaylı inceleyeceğim. Bu saate kadar kodla uğraştım ama işin içinden çıkamadım. Kısmen çözdüm ama bazı yerlerde hata veriyor. Cevabınız için tekrardan teşekkür ederim.

 

[turist]

Merhaba arkadaşlar. Tek hücredeki karışık veriyi satır ve sütunlara ayırmak istiyorum. Dosyada daha net anlaşılıyor. Cevaplarınız için şimdiden teşekkür ederim.

Sayın @Muhammet Okumuş ,
Dosyanız eklidir.
Örnek Sayfasında deneyiniz.
Not: Kodlar hızlıca düzenlenmiştir, kendiniz sadeleştirebilirsiniz.

 

[Ömer BARAN]

Tekrar merhaba.

Önceki cevabımdan farklı olarak;
ilgili alan dışında bir hücreye veri yazma, hücre ayırma/birleştirme/sütunlara dağıtma vs yok, sadece Split ve Replace komutu.
Böyle daha iyi oldu..

Sub AYRISTIR_BRN2()
If Cells(Rows.Count, 3).End(3).Row > 2 Then Range("B3:F" & Rows.Count).ClearContents
satir = Len(Replace([B1], " ", "")) - Len(Replace(Replace([B1], " ", ""), ";", ""))
For ob = 0 To satir
    brn1 = Split(Split(Replace([B1], " ", ""), ";")(ob), "-")(0)
    brn2 = Split(Split(Replace([B1], " ", ""), ";")(ob), "-")(1)
    Cells(ob + 3, 2) = ob + 1
    If Len(brn1) <> Len(Replace(brn1, ")", "")) Then
        Cells(ob + 3, 5) = Replace(Split(brn1, "(")(1), ")", "")
            Cells(ob + 3, 3) = Replace(brn1, "(" & Replace(Split(brn1, "(")(1), ")", "") & ")", "")
                Else: Cells(ob + 3, 3) = brn1
                    End If
                    If Len(brn2) <> Len(Replace(brn2, ")", "")) Then
                Cells(ob + 3, 6) = Replace(Split(brn2, "(")(1), ")", "")
            Cells(ob + 3, 4) = Replace(brn2, "(" & Replace(Split(brn2, "(")(1), ")", "") & ")", "")
        Else: Cells(ob + 3, 4) = brn2
    End If
Next: MsgBox "İşlem tamamlandı.", 8, "..:: Ömer BARAN ::.."
End Sub

 

[Muhammet Okumuş]

Sn turist ve Ömer Bey, cevaplarınız için çok teşekkür ederim. Sorun sayenizde çözüme kavuştu.

 

[turist]

Sn turist ve Ömer Bey, cevaplarınız için çok teşekkür ederim. Sorun sayenizde çözüme kavuştu.

Sağ olun.

 

[Ömer BARAN]

Estağfurullah.
Kolay gelsin.
.