cel inhoud splisten naar nieuwe rij

[hermanw]

ik heb een excel sheet waar in kolom B 1 of meerdere waardes kunnen voorkomen, kan ik op basis hiervan een nieuwe rij aanmaken met de tweede of derde waarde onder de originele rij

voorbeeld

locatie ICT + ELec 3 bouwen 5 uitgever1
locatie ICT + ELec 3 bouwen 6 uitgever2

moet worden

locatie ICT 3 bouwen 5 uitgever1
locatie Elec 3 bouwen 5 uitgever1
locatie ICT 3 bouwen 6 uitgever2
locatie Elec 3 bouwen 6 uitgever2

 

[Timshel]

Beter plaats je een voorbeeldbestand met 10 tot 20 regels met alle mogelijke combinaties, waarin bovendien duidelijk wordt welk resultaat je wenst.

 

[Peter B]

Het voorbeeld is nog niet helemaal scherp. Wat wil je in geval regel 8 en 9?

Moet in geval regel 8 dit het resultaat worden?
ICT 3 etc
ICT 4 etc
Elec 3 etc
Elec 4 etc

 

[hermanw]

nee alleen nieuwe regel op basis van tweede kolom
dus die regels worden
ict 3+4
elec 3+4

 

[Peter B]

Volgens mij zou dit moeten werken. Het kan vast slimmer/ sneller/ beter ... maxSource is het aantal bronregels. Start tellerTarget is de eerste regel waar data wordt gekopieerd. Dit is dus naar wens aan te passen.

Sub splits()
Dim tellerSource, maxSource, tellerTarget As Long

maxSource = 19
tellerTarget = 32

For tellerSource = 1 To maxSource
    Range("A" & tellerTarget, "K" & tellerTarget).Value = _
        Range("A" & tellerSource, "K" & tellerSource).Value
    tellerTarget = tellerTarget + 1
    If InStr(1, Cells(tellerSource, 2), " + ", vbTextCompare) > 1 Then
        Range("A" & tellerTarget, "K" & tellerTarget).Value = _
            Range("A" & tellerSource, "K" & tellerSource).Value
        Range("B" & tellerTarget - 1).Value = Mid(Range("B" & tellerSource).Value, 1, _
            InStr(1, Range("B" & tellerSource).Value, " + ", vbTextCompare) - 1)
        Range("B" & tellerTarget).Value = Mid(Range("B" & tellerSource).Value, _
            InStr(1, Range("B" & tellerSource).Value, " + ", vbTextCompare) + 3, 10)
        tellerTarget = tellerTarget + 1
    End If
Next tellerSource

End Sub

 

[hermanw]

Super bedankt hiermee kan ik weer verder, het werkt
ga nu proberen het uit te bouwen omdat er ook regels zijn met meer dan 1 + teken.

 

[Peter B]

Vandaar dat een representaties voorbeeld wordt gevraagd ... Je kunt tellen hoe vaak de " + " voorkomt en zo vaak loopen op de plaats van "If InStr(1, Cells(tellerSource, 2), " + ", vbTextCompare) > 1 Then"

 

[VenA]

Om het wat dynamischer te maken. Met uitkomst op 'Blad2'

Sub VenA()
ar = Sheets("blad1").Cells(1).CurrentRegion.Resize(, 11)
ReDim ar1(UBound(ar, 2), 0)
For j = 1 To UBound(ar)
    For jj = 0 To UBound(Split(ar(j, 2), "+"))
        ReDim Preserve ar1(UBound(ar, 2), t)
        For jjj = 1 To UBound(ar, 2)
            ar1(jjj - 1, t) = ar(j, jjj)
        Next jjj
        ar1(1, t) = Split(ar(j, 2), "+")(jj)
        t = t + 1
    Next jj
Next j
Sheets("Blad2").Cells(1).Resize(UBound(ar1, 2) + 1, UBound(ar1) + 1) = Application.Transpose(ar1)
End Sub