vba - 如果多个值在单个单元格中，则在 vba 中创建多行

Question

我有一个数据，其中多个值在单个单元格中，我必须分别排列所有值。你能帮帮我吗？非常感谢您的建议。

我无法附加文件..

Countries   Cobination  Products    Q1 QUANTITY Q2 QUANTITY Q3 QUANTITY Q4 QUANTITY
USA First   Machine 90  340 600 900
Canada / USA / CHINA    First   Computer , Vehicles , Households    80  112 112 34
BRAZIL , CHINA , SA     BOOKS   10  600 0   698
CANADA  Second  BOTTLES / CARPET    4000    3243        4449

结果如下

Countries       Products    Q1 QUANTITY Q2 QUANTITY Q3 QUANTITY Q4 QUANTITY
USA First   Machine 90  340 600 900
Canada  First   Computer    80  112 112 34
USA First   Computer    80  112 112 34
CHINA   First   Computer    80  112 112 34
Canada  First   Vehicles    80  112 112 34
USA First   Vehicles    80  112 112 34
CHINA   First   Vehicles    80  112 112 34
Canada  First   Households  80  112 112 34
USA First   Households  80  112 112 34
CHINA   First   Households  80  112 112 34
BRAZIL      BOOKS   10  600 0   698
CHINA       BOOKS   10  600 0   698
SA      BOOKS   10  600 0   698
CANADA  Second  BOTTLES 4000    3243        4449
CANADA  Second  CARPET  4000    3243        4449

Answer 1

检查一下，这可能不是最佳解决方案。我用了3个程序。

Cell3_Count():从 cell1 和 cell3 中的字符串组合中知道要插入的行数。

split_cell3() :根据分隔符拆分单元格值。

ArrangeBasedOnValues():对于 cell1 和输出具有 1. 和 2. 功能。

请检查不同的情况，并根据需要进行必要的更改。

选项显式
选项比较文本

公共(public) sht1 作为工作表，i As Long，j As Long，lastrow1 As Long，k As Long，l As Long
公共(public) str1 作为字符串，str2() 作为字符串，str3() 作为字符串，str4 作为字符串，s1 作为字符串，s2 作为字符串，s3 作为字符串，s4 作为字符串
公共(public) cnt1 作为字符串，cnt2 作为整数，ncells 作为整数

子 ArrangeBasedOnValues()

Set sht1 = ThisWorkbook.Worksheets(1)

'Starting row
i = 6

下一个单元格:

lastrow1 = sht1.Cells(sht1.Rows.Count, "A").End(xlUp).Row

Do While (i <= lastrow1)

    str1 = sht1.Cells(i, 1).Value

    str4 = sht1.Cells(i, 3).Value

    s1 = "/"

    s2 = ","

    cnt1 = 0

    'Check number of strings in cell1
    If InStr(1, str1, s1, vbTextCompare) > 0 Then

        s4 = s1

        'count of special characters in cell1
        cnt1 = Len(str1) - Len(Replace(str1, s1, ""))

        Call Cell3_Count

    ElseIf InStr(1, str1, s2, vbTextCompare) > 0 Then

        s4 = s2

        cnt1 = Len(str1) - Len(Replace(str1, s2, ""))

        Call Cell3_Count

    Else

        Call Cell3_Count

    End If

    'combination of elements in cell1 and cell3
    'cnt1+1 : Total numbers of strings = total number of spl chars + 1
    ncells = ((cnt1 + 1) * (cnt2 + 1)) - 1

    'Only one string in cell1
    If ncells = 1 Then

        'Add extra rows based on the combination
        sht1.Rows(i + 1 & ":" & i + ncells).Insert Shift:=xlDown, _
        CopyOrigin:=xlFormatFromLeftOrAbove

        sht1.Cells(i + 1, 1).Value = sht1.Cells(i, 1).Value

        sht1.Range("B" & i + 1).Value = Trim(sht1.Range("B" & i).Value)

        sht1.Range("D" & i & ":" & "G" & i).Copy sht1.Range("D" & i + 1 & ":" & "G" & i + 1)

        Call split_cell3

    'more than one string
    ElseIf ncells > 1 Then

        sht1.Rows(i + 1 & ":" & i + ncells).Insert Shift:=xlDown, _
        CopyOrigin:=xlFormatFromLeftOrAbove

        Dim q As Integer

        q = i

        str2 = Split(str1, s4)

        For k = LBound(str2) To UBound(str2)

            'UBound(str2) + 1 : number of times each string in cell4 needs to be printed

            For l = q To i + ncells Step UBound(str2) + 1

                sht1.Cells(l, 1).Value = Trim(str2(k))

                sht1.Range("B" & l).Value = Trim(sht1.Range("B" & i).Value)

                'cnt2=0 : only one string in cell3
                If cnt2 = 0 Then

                    sht1.Range("C" & i & ":" & "G" & i).Copy sht1.Range("C" & l & ":" & "G" & l)

                'More than one string in cell3
                Else

                    sht1.Range("D" & i & ":" & "G" & i).Copy sht1.Range("D" & l & ":" & "G" & l)

                End If

            Next l

            q = q + 1

        Next k

        'cnt2>0 : need to split strings in cell3
        If cnt2 > 0 Then

            Call split_cell3

        End If

        i = i + ncells + 1

        GoTo next_cell

    'Only one string in both cell1 and cell3
    Else

        i = i + 1

        GoTo next_cell

    End If

    i = i + ncells + 1

    lastrow1 = sht1.Cells(sht1.Rows.Count, "A").End(xlUp).Row

Loop

结束子
'cell3中的字符串数
子 Cell3_Count()

cnt2 = 0

'Check number of values
If InStr(1, str4, s1, vbTextCompare) > 0 Then

    s3 = s1

    'count of special characters in cell3
    cnt2 = Len(str4) - Len(Replace(str4, s1, ""))

ElseIf InStr(1, str4, s2, vbTextCompare) > 0 Then

    s3 = s2

    cnt2 = Len(str4) - Len(Replace(str4, s2, ""))

End If

结束子

'根据cell3_count中得到的分隔符拆分cell3中的字符串
子 split_cell3()

str3() = Split(str4, s3)

Dim m As Integer, n As Integer

m = i

'Debug.Print cnt1 + 1

For n = LBound(str3) To UBound(str3)

    For l = m To m + cnt1

        sht1.Range("C" & l).Value = Trim(str3(n))

    Next l

    m = m + cnt1 + 1

Next n

结束子