为多值字段创建单独的行条目

时间:2012-11-27 22:54:40

标签: excel vba excel-vba

我有一个包含项目列表的表格。从本质上讲,它是从问题跟踪工具导出的。该表的一列包含以逗号分隔的值。我正在寻找一种方法来为多值条目的各个值创建单独的条目。

示例:(这是一个简化示例,真实案例包含大约十几列)

来源数据:

ID | Title          |  Areas Affected  |  
1  | Issue title A  |  Area X, Area Y  |  
2  | Issue title B  |  Area Y, Area Z  |  
3  | Issue title C  |  Area X, Area Z  |  

我想要达到的目的:

ID | Title          |  Areas Affected  |   
1  | Issue title A  |  Area X          |  
1  | Issue title A  |  Area Y          |  
2  | Issue title B  |  Area Y          |  
2  | Issue title B  |  Area Z          |  
3  | Issue title C  |  Area X          |  
3  | Issue title C  |  Area Z          |  

现在可以存在ID和标题的重复条目吗?

是否有公式,宏或VBA脚本来实现这一目标?

2 个答案:

答案 0 :(得分:2)

您需要使用逗号作为分隔符来拆分该列上的行。在VBA中,您可以使用Split()函数返回数组。对于第一个元素,只需将其放回列表所在的单元格中。对于其他元素,为数组中的每个元素插入一个新行(意味着您可以在该逗号分隔列表中包含n个元素),复制该新行上的整行并将第i个值放入其中。

答案 1 :(得分:1)

在阅读/浏览示例代码之后,如果有人需要,这里是答案。这是实际的工作代码,不符合我在问题中发布的示例的1:1。

Sub DataLobs()
    Application.ScreenUpdating = False 'Nice to have to increase the script speed. 

    Dim wsSrc As Worksheet
    Dim wsDst As Worksheet
    Dim curRowSrc As Integer
    Dim curRowDst As Integer
    Dim ttlRows As Integer
    Dim splitLob() As String

    ' Setting initial values to start rows in source and destination
    ' tables, as well as the total number of rows
    curRowSrc = 5
    curRowDst = 5
    ttlRows = 10000

    Set wsSrc = Worksheets("Source") 'whatever you worksheet is
    Set wsDst = Worksheets("Destination") 'or whatever your worksheet is called

    wsDst.Range("A5:F" & ttlRows).Clear

    ' Goes through column D in the source table
    ' and copies rows where the D cell is not blank
    ' into the destination table
    For curRowSrc = 5 To ttlRows
        If wsSrc.Range("D" & curRowSrc).Value <> "" Then ' There are some blank cells in the source table, so we are eliminating them.

            ' Split the cell value against the comma
            splitLob = Split(wsSrc.Range("D" & curRowSrc).Value, ", ") 'THIS IS WHERE @AlexandreP.Levasseur's HINT COMES INTO PLAY!

            For i = LBound(splitLob) To UBound(splitLob)
                wsDst.Range("A" & curRowDst).Value = splitLob(i)
                wsDst.Range("B" & curRowDst).Value = wsSrc.Range("A" & curRowSrc)
                wsDst.Range("C" & curRowDst).Value = wsSrc.Range("C" & curRowSrc)
                wsDst.Range("D" & curRowDst).Value = wsSrc.Range("AC" & curRowSrc)
                wsDst.Range("E" & curRowDst).Value = wsSrc.Range("AE" & curRowSrc)
                wsDst.Range("F" & curRowDst).Value = wsSrc.Range("AD" & curRowSrc)
                curRowDst = curRowDst + 1
            Next
        End If
    Next curRowSrc
End Sub