gegevens in tabel splitsen

[Jan van Voren]

Ik wil graag in een BOM (Bill of Materials) van electronica componenten, voor elke locatie een aparte regel maken met daarin het artikel nummer weet iemand hoe dit te realiseren is (zie bijlage - is handmatig gemaakt)


Jan

 

[jheesterbeek]

Met een macro'tje zou je de location kunnen splitsen. Je zoekt op de , en selecteerd alles van komma tot komma.
Ben je bekend met macro's?

 

[Jan van Voren]

Nee ik ben niet bekend met macro's

 

[koosl]

Jan,

Is het voldoende als je de kolommen B en C verbergt?
Dan heb je toch ook hetzelfde?
Of zie ik het niet goed?

Koosl

 

[Jan van Voren]

Nee want het is de bedoeling dat het laatste veld gesplitst wordt

 

[Wigi]

Jan

is dit werk eenmalig of moet het vaak toegepast worden?

Wigi

 

[Jan van Voren]

Wigi,

Nee dit werk wordt vaak toegepast, en dan met veel meer regels dan er op het voorbeeld te zien zijn.

Jan

 

[Wigi]

Probeer dit eens uit op het getoonde voorbeeld, Jan

Sub split()
    Dim lCount As Long, c As Range
    
    Range("D3:D7").Select
    Selection.TextToColumns Destination:=Range("D3"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        Comma:=True, FieldInfo:=Array(Array(3, 4), Array(7, 4)), TrailingMinusNumbers:=True
    
    lCount = 0
    
    For Each c In Range("E3", _
        Range("D2").End(xlDown).Offset(0, WorksheetFunction.Max(Range("C3", Range("C3").End(xlDown)))))
    
        If c <> "" Then
            Range("A12").Offset(lCount + 1, 0) = Range("A" & c.Row)
            Range("A12").Offset(lCount + 1, 1) = c
            lCount = lCount + 1
            c.ClearContents
        End If
    Loop
End Sub

Wigi

 

[Jan van Voren]

Ik heb het geprobeerd maar krijg de foutmelding "Loop without Do"

Johan

 

[jheesterbeek]

onder staat "loop", vervang dit door "Next"

 

[Wigi]

Ja, foutje

 

[Jan van Voren]

Bedankt voor de macro, het werkt nog niet helemaal goed maar ik zal proberen deze te optimaliseren.

Jan

 

[Wigi]

Dit is 'm helemaal Jan

Sub split()
    Dim lCount As Long, c As Range
    
    Range("D3:D7").Select
    Selection.TextToColumns Destination:=Range("D3"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        Comma:=True, FieldInfo:=Array(Array(3, 4), Array(7, 4)), TrailingMinusNumbers:=True
    
    lCount = 0
    
    For Each c In Range("D3", _
        Range("D2").End(xlDown).Offset(0, WorksheetFunction.Max(Range("C3", Range("C3").End(xlDown)))))
    
        If c <> "" Then
            Range("A12").Offset(lCount + 1, 0) = Range("A" & c.Row)
            Range("A12").Offset(lCount + 1, 1) = c
            lCount = lCount + 1
            c.ClearContents
        End If
    Next
    Range("A1").Select
End Sub

Ik heb het getest.

Wigi