将多列数据转换为每列的单行

Question

我有一个包含多列的数据集。对于A列中的每个单元格，其他列中的单元格数量可变。寻找帮助制作宏，为A列的每个组合创建单行，并在其他列中创建相应的单元格。示例输入：

Posted on   Tags
3/8/15  Tag A
3/8/15  Tag B, Tag C
3/8/15  Tag C, Tag B, Tag D
3/9/15  Tag D
3/10/15 Tag D, Tag F
3/10/15 Tag B
3/10/15 Tag D, Tag E

Desired output:

Posted on   Tags
3/8/15  Tag A
3/8/15  Tag B
3/8/15  Tag C
3/8/15  Tag C
3/8/15  Tag B
3/8/15  Tag D
3/9/15  Tag D
3/10/15 Tag D
3/10/15 Tag F
3/10/15 Tag B
3/10/15 Tag D
3/10/15 Tag E

Answer 1

我不确定这些昏迷是显示每一列还是实际上是该值的一部分。

我认为每种类型都只是在它自己的列中：

宏假设您在包含类型的工作表处于活动状态时运行它并且＆＃34;固定数据＆＃34;将被放置在＆＃34; Sheet2＆＃34;

如果不是这种情况，请更改/添加工作表参考。

Sub FixMyData()
'x will iterate through each row on our ActiveSheet from 1 to the last row
'y will iterate through each column (Tag) if there are more than 2
'z will keep track of the row we are outputting to on Sheet2
Dim x, y, z

z = 1 'Start outputting on row 1

'This line just speeds up macros that modify sheets significantly
Application.ScreenUpdating = False

'Start at the first row on our active sheet and iterate through each one
For x = 1 To GetLastRow(ActiveSheet.Name, 1)
    'This is a new row so get the date and put it on sheet2
    Sheets("Sheet2").Cells(z, 1).Value = Cells(x, 1)

    'Grab the first tag (if it exists) and put it there too
    Sheets("Sheet2").Cells(z, 2).Value = Cells(x, 2)

    'We're ready to output to the next row
    z = z + 1

    'If there is more than one tag on this row
    If GetLastCol(ActiveSheet.Name, x) > 2 Then

        'Let's read through each one and output it in the same way
        For y = 3 To GetLastCol(ActiveSheet.Name, x)
            'Stick the date on Sheet2
            Sheets("Sheet2").Cells(z, 1).Value = Cells(x, 1)

            'And stick the tag next to it
            Sheets("Sheet2").Cells(z, 2).Value = Cells(x, y)

            'We're ready to write to the next row again
            z = z + 1
        Next y
    End If
Next x

'Format column A on Sheet2 as dates (since we're not using copy)
Sheets("Sheet2").Range("A1:A" & GetLastRow("Sheet2", "A")).NumberFormat = "m/d/yyyy"
Application.ScreenUpdating = True
End Sub

'Helper functions that make the code easier to read
'They return the last Row/Column (respectively) with data
'-------------------------------------------------------------
Function GetLastRow(sheet As String, col As Variant) As Integer
GetLastRow = Sheets(sheet).Cells(Sheets(sheet).Rows.Count, col).End(xlUp).row
End Function
Function GetLastCol(sheet As String, row As Variant) As Integer
GetLastCol = Sheets(sheet).Cells(row, Sheets(sheet).Columns.Count).End(xlToLeft).Column
End Function
'-------------------------------------------------------------

结果：