Mehrere durch Kommas getrennte Spalten in Zeilen aufteilen

Question

Bitte Hilfe.

Ich versuche, mehrere durch Komma getrennte Werte pro Kunde Id aufzuspalten, ich habe Arbeit dies für eine einzelne Spalte, aber der schwierige Teil dieser auf mehrere Spalten

zum Beispiel bewirbt Quelle

Cust Id | Value 1 | Value 2 
1  | 3,4  | a2,a3 
2  | 1,2,3 | a1,a3,a5 

Required Out

Cust Id | Value 1 | Value 2 
1  | 3  | a2 
1  | 4  | a3 
2  | 1  | a1 
2  | 2  | a3 
2  | 3  | a5 

Ich habe versucht, eine Lookup-Tabelle verwendet, die eine einzelne Integer-Spalte von 1 bevölkert enthält - 100, die die maximale Anzahl von getrennten Werten sein sollte. Ich diese dann in der folgenden Abfrage verwendet, um die Werte aufzuschlüsseln, der gut arbeitet, aber nur für eine Spalte

SELECT ID, TRIM(Mid(',' & Value1 & ',',[Entries]+1,Instr([Entries]+1,',' & Value1 & ',',',')-([Entries]+1))) AS Split 
FROM MyTable 
WHERE Entries=Instr(Entries,',' & Value1 & ',',',') And Entries<len(',' & Value1) 

Answer 1

Unter der Annahme, dass die Anzahl der Kommas in Value 1 und Value 2 Felder gleich sind, hier ist eine Idee:

'needs reference to MS ActiveX Data Objects xxx Library 
Sub SplitData() 

Dim oRst As ADODB.Recordset 
Dim sSQL As String, oVars1 As Variant, oVars2 As Variant 
Dim i As Integer 

On Error GoTo Err_SplitData 

sSQL = "SELECT * FROM Customers;" 

Set oRst = New ADODB.Recordset 
With oRst 
    'open recordset 
    .Open sSQL, CurrentProject.Connection, adOpenStatic, adLockReadOnly 
    'fill-in recordset 
    .MoveLast 
    .MoveFirst 
    'loop through the records in Customers table 
    Do While Not .EOF 
     'split data 
     oVars1 = Split(.Fields("Value1").Value, ",") 
     oVars2 = Split(.Fields("Value2").Value, ",") 
     'loop through the splited data 
     For i = 0 To UBound(oVars1) 
      'improve this piece of code 
      ' 
      'only for example - print data 
      Debug.Print .Fields("CustID"), oVars1(i), oVars2(i) 

     Next 
     .MoveNext 
    Loop 
    .Close 
End With 

Exit_SplitData: 
    On Error Resume Next 
    Set oRst = Nothing 
    Exit Sub 

Err_SplitData: 
    MsgBox Err.Number, vbExclamation, Err.Number 
    Resume Exit_SplitData 

End Sub 

Answer 2

Maciej‘Antwort sieht gut aus, aber wie ich bereits für Sie auf einer Antwort gearbeitet hatte, werde ich weitermachen und es schreiben sowieso:

Option Explicit 

Sub FncCreateOutput() 

    Dim rowCount As Long 
    Dim custID As Long 
    Dim value1Str As Variant 
    Dim value2Str As Variant 

    Sheets("Input").Select 

    'We start at row two as this is a header line 
    rowCount = 2 

    Do While Range("A" & rowCount).Value <> "" 

     'Reselect the Input sheet - it will have been deselected by previous calls to 'FncWriteIDValues()' 
     Sheets("Input").Select 

     custID = Range("A" & rowCount).Value 
     value1Str = Split(Range("B" & rowCount).Value, ",") 
     value2Str = Split(Range("C" & rowCount).Value, ",") 

     'You need to check that you have the same count of values in the two variant arrays 
     If UBound(value1Str) <> UBound(value2Str) Then 

      Stop 

     Else 

      'They match so we can now pass this information to a function that will write to another sheet 
      Call FncWriteIDValues(custID, value1Str, value2Str) 

     End If 
     rowCount = rowCount + 1 

    Loop 

End Sub 

Private Function FncWriteIDValues(id As Long, val1 As Variant, val2 As Variant) 

    Dim totalRows As Long 
    Dim i As Integer 

    Sheets("Output").Select 

    'Get the total rows in the 'Ouput' sheet used so far 
    totalRows = ActiveSheet.UsedRange.Rows.count 

    Do While i <= UBound(val1) 

     Range("A" & totalRows + 1).Value = id 
     Range("B" & totalRows + 1).Value = val1(i) 
     Range("c" & totalRows + 1).Value = val2(i) 
     i = i + 1 
     totalRows = totalRows + 1 
    Loop 

End Function 

Sie erstellen zwei Blätter in Excel, eines als "Eingabe" und eines als "Ausgabe". Tragen Sie in Ihrem "Eingabe" -Blatt den Kopf und die Daten und in "Ausgabe" nur die Kopfzeile in Zeile 1 ein. Der Code erledigt den Rest.