将多列中的多个值拆分为 Excel 中的行。

Question

The excel columns i am having, where i need the first element in Col B to be mapped against first element in Col C and so on.

Column A     Column B             Column C
Electrical   Lighting,Thunder     Bad,Good
Mechanical   Nut, Bolt            Bad,Good

The result I want:

Column A     Column B     Column C
Electrical   Lighting     Bad
Electrical   Thunder      Good
Mechanical   Nut          Bad
Mechanical   Bolt         Good

Answer 1

If all these values are in Sheet1, simply make sure that you have a Sheet2 for your results, then this code will do what you expect:

EDIT:

It will now work for single values too:

Sub foo()
Dim LPosition As Integer 'declare variables
Dim LPosition2 As Integer
Dim LastRow As Long
Dim NextEmptyRow As Long
Dim strName As String
Dim TempArray1() As String
Dim TempArray2() As String

LastRow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row 'find the last row on column A on Sheet1
For i = 2 To LastRow 'loop from row 2 to the last row
    strName = Sheet1.Cells(i, 1).Value 'get the value of column A into a variable
    LPosition = InStr(Sheet1.Cells(i, 2).Value, ",") ' check if column B has a comma in it
    If LPosition > 0 Then
        TempArray1 = Split(Sheet1.Cells(i, 2).Value, ",") 'if comma found put values into an array
    Else
        TempArray1(0) = Sheet1.Cells(i, 2).Value
    End If

    LPosition2 = InStr(Sheet1.Cells(i, 3).Value, ",") 'check for a comma on Column C
    If LPosition2 > 0 Then
        TempArray2 = Split(Sheet1.Cells(i, 3).Value, ",") 'place values into a separate Array
    Else
        TempArray2(0) = Sheet1.Cells(i, 3).Value
    End If
    For x = 0 To UBound(TempArray1) 'loop through the array
        NextEmptyRow = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row + 1 'check the next free row on Sheet2
        Sheet2.Cells(NextEmptyRow, 1).Value = Trim(strName) 'place appropriate values
        Sheet2.Cells(NextEmptyRow, 2).Value = Trim(TempArray1(x))
        Sheet2.Cells(NextEmptyRow, 3).Value = Trim(TempArray2(x))
    Next x
    ReDim TempArray1(0)
    ReDim TempArray2(0)
Next i
End Sub