string vervangen door new line

[DannyGeysen]

Kolom A telt honderden rijen data met volgende inhoud:

17071830;48726600;-103/0:17071830;48726650;-101/0:17071840;48726550;-106/0:17071840;48726580;-105/0:

Bij elke string "/0:" zou ik een nieuwe rij willen beginnen op een 2e werkblad.
(Elke rij bevat dus 4 zulke strings.)

Hoe is dit te doen?

Hartelijk dank,

 

[ExcelAmateur]

DannyGeysen,

Is Tekst naar kolommen misschien een optie?
Zijn de getallen over 4 kolommen verdeeld.
Dan een kolom kopieren en op een ander blad plakken.

Zulke handelingen kun je met de macrorecorderopnemen en naderhand proberen deze code te vereenvoudigen.

 

[DannyGeysen]

Bovenstaand voorbeeld bevat de data van de cel A1 (dus 4 strings in 1 cel)
Zo bevalt kolom A honderden rijen.

 

[E v R]

Op basis van jouw gegevens zonder voorbeeldbestandje:

Sub tst()
Dim j As Long, i As Integer, x As Variant
    j = 1
    For Each cel In Sheets("Blad1").Range("a1:a" & Sheets("Blad1").Cells(Rows.Count, "A").End(xlUp).Row)
        x = Split(cel.Value, "/0:")
        For i = 1 To 4
            Sheets("Blad2").Cells(j, 1).Value = x(i - 1) & "/0:"
            j = j + 1
        Next i
    Next
End Sub

 

[ExcelAmateur]

Bij Tekst naar kolommen hoef je zelf niets te doen.
Alleen aangeven waar hij moet splitsen en dan zet 1 string per kolom.
Doe dit even op een test bestandje, kan er niets mis gaan met het orginele bestandje.
17071830;48726600;-103/0 17071830;48726650;-101/0 17071840;48726550;-106/0 17071840;48726580;-105/0
Zo ziet het er bij mij uit, dus na de /0 komt het volgende getal in een andere kolom.

 

[ExcelAmateur]

E v R,

Mooi stukje code.
Het rode heb ik er tussen gezet er kwam een fout melding, nu niet meer.

Sub tst()
Dim j As Long, i As Integer, x As Variant
    j = 1
    For Each cel In Sheets("Blad1").Range("A1:A19")
    [COLOR="red"]If cel.Value = "" Then Exit Sub[/COLOR]
        x = Split(cel.Value, "/0:")
        For i = 1 To 4
            Sheets("Blad2").Cells(j, 1).Value = x(i - 1) & "/0:"
            j = j + 1
        Next i
    Next
End Sub

 

[E v R]

Yep :thumb:
Daarom had ik de code nog even aangepast

 

[DannyGeysen]

Op basis van jouw gegevens zonder voorbeeldbestandje:

Sub tst()
Dim j As Long, i As Integer, x As Variant
    j = 1
    For Each cel In Sheets("Blad1").Range("a1:a" & Sheets("Blad1").Cells(Rows.Count, "A").End(xlUp).Row)
        x = Split(cel.Value, "/0:")
        For i = 1 To 4
            Sheets("Blad2").Cells(j, 1).Value = x(i - 1) & "/0:"
            j = j + 1
        Next i
    Next
End Sub

Eric,

Deze is bijna perfect.

Op het einde van elke cel, voegt hij "/0:" toe. Het ware beter als dit er niet meer bij zou staan.

Ik heb gemerkt dat in mijn bestand om de (ongeveer) 500 rijen er 1 rij volgt met slechts 1 string i.p.v. 4 strings. Op zulk een rij stopt de macro dan met een foutmelding op:
Sheets("Blad2").Cells(j, 1).Value = x(i - 1) & "/0:"

 

[E v R]

Iets aangepast:

Sub tst()
Dim j As Long, i As Integer, x As Variant, cel as range
    j = 1
    For Each cel In Sheets("Blad1").Range("a1:a" & Sheets("Blad1").Cells(Rows.Count, "A").End(xlUp).Row)
        x = Split(cel.Value, "/0:")
        For i = 1 To UBound(x)
            Sheets("Blad2").Cells(j, 1).Value = x(i - 1)
            j = j + 1
        Next i
    Next
End Sub

 

[DannyGeysen]

Iets aangepast:

Sub tst()
Dim j As Long, i As Integer, x As Variant, cel as range
    j = 1
    For Each cel In Sheets("Blad1").Range("a1:a" & Sheets("Blad1").Cells(Rows.Count, "A").End(xlUp).Row)
        x = Split(cel.Value, "/0:")
        For i = 1 To UBound(x)
            Sheets("Blad2").Cells(j, 1).Value = x(i - 1)
            j = j + 1
        Next i
    Next
End Sub

Helemaal perfect Eric! Hartelijk dank voor deze snelle en perfecte hulp.
Ook dank aan iedereen die mee geholpen heeft.