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

时间:2017-12-18 17:50:21

标签: excel excel-vba excel-formula vba

我正在使用excel列,我需要将Col B中的第一个元素映射到Col C中的第一个元素,依此类推。

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

我想要的结果:

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

1 个答案:

答案 0 :(得分:0)

如果所有这些值都在Sheet1中,只需确保您的结果有Sheet2,那么此代码将按预期执行:

修改

它现在也适用于单个值:

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