Question

我想将excel中的值与唯一数据分开。我有大量数据，如下所示。

1 Apple,Orange,Apricot  Fruit,Vegetable  Cat1,Cat2
2 Aubergine,Avocado     Vegetable        Cat2,Cat3,Cat4
3 Banana                Fruit            Cat5

我只想使用excel VBA将以上值拆分为以下拆分值。多列包含逗号分隔值。必须使用唯一数据将值拆分为新行。

1 Apple      Fruit      Cat1
1 Apple      Fruit      Cat2
1 Apple      Vegetable  Cat1
1 Apple      Vegetable  Cat2
1 Orange     Fruit      Cat1
1 Orange     Fruit      Cat2
1 Orange     Vegetable  Cat1
1 Orange     Vegetable  Cat2
1 Apricot    Fruit      Cat1
1 Apricot    Fruit      Cat2
1 Apricot    Vegetable  Cat1
1 Apricot    Vegetable  Cat2
2 Aubergine  Vegetable  Cat2
.......................

你能帮助我吗？

Answer 1

对于注册了软件开发课程的人来说，确实看起来很像是一项家庭作业。

你的第一个循环是取字符串“Apple，Orange，Apric”，它最多包含22个字符并由COMMA爆炸，然后遍历其元素。嵌套的第二个LOOP也是用字符串“Fruit，Vegetable”做的，它最多包含17个字符并由COMMA将其爆炸，然后遍历其元素。你的嵌套嵌套第三个LOOP是......你明白了。由于Apple既可以映射到水果和蔬菜，也可以映射到Cat1和Cat2，因此输出最终会有4个Apple实例。这种提取也称为笛卡尔积，其中1x2x2 = 4。

因此，这样做的目的是教你如何在逗号字符上拆分字符串，然后使用生成的逗号分隔字符串数组来循环操作。

为什么在这个问题上没有200点声望赏金？嗯......很难说（我在开玩笑）。但从好的方面来说，它很简单，即使我能回答它，所以这就是它！祝你有美好的一天。

Answer 2

Public Sub SliceNDice()

    Dim objRegex As Object
    Dim X
    Dim Y
    Dim lngRow As Long
    Dim lngCnt As Long
    Dim tempArr() As String
    Dim strArr
    Set objRegex = CreateObject("vbscript.regexp")
    objRegex.Pattern = "^\s+(.+?)$"
     'Define the range to be analysed
    X = Range([a2], Cells(Rows.Count, "c").End(xlUp)).Value2
    ReDim Y(1 To 3, 1 To 1000)
    For lngRow = 1 To UBound(X, 1)
         'Split each string by ","
        tempArr = Split(X(lngRow, 2), ",")
        For Each strArr In tempArr
            lngCnt = lngCnt + 1
             'Add another 1000 records to resorted array every 1000 records
            If lngCnt Mod 1000 = 0 Then ReDim Preserve Y(1 To 3, 1 To lngCnt + 1000)
                Y(1, lngCnt) = X(lngRow, 1)
                Y(3, lngCnt) = objRegex.Replace(strArr, "$1")
        Next
    Next lngRow

    Worksheets("Test_Execution").Range("A1").Value = "Req. JIRA#"
    Worksheets("Test_Execution").Range("B1").Value = "Req. JIRA Summary"
    Worksheets("Test_Execution").Range("C1").Value = "Test JIRA#"
    Worksheets("Test_Execution").Range("D1").Value = "Test JIRA Summary"
    Worksheets("Test_Execution").Range("E1").Value = "Issue Type"
    Worksheets("Test_Execution").Range("F1").Value = "Execution Status"
    Worksheets("Test_Execution").Range("G1").Value = "Comments"


     'Dump the re-ordered range to columns C:D
    Worksheets("Test_Execution").[a2].Resize(lngCnt, 3).Value2 = Application.Transpose(Y)
End Sub

将多个逗号分隔的条目从多个列拆分为excel宏VBA中具有唯一数据的新行

2 个答案: