Question

我需要在excel中编写一些小代码，用于分隔用逗号分隔的数据的行。示例：

row 1: column A: "data_1,data_2,data_3" column B:  "do_this_1"
row 2: column A: "data_4,data_5,data6" column B: "do_this_2"

这需要更改为单独的行，因此它将变为：

row 1: column a: "data_1" column B: "do_this_1"
row 2: column a: "data_2" column B: "do_this_1"
row 3: column a: "data_3" column B: "do_this_1"
row 4: column a: "data_4" column B: "do_this_2"
row 5: column a: "data_5" column B: "do_this_2"
row 6: column a: "data_6" column B: "do_this_2"

编辑：截图进行更详细的提问：

任何人都知道如何使用VBA代码执行此操作？

提前致谢！

Answer 1

您可以使用：

function SetFontSpacing( $size ) {
   if ( $this->FontSpacingPt == $size ) return;

   $this->FontSpacingPt = $size;
   $this->FontSpacing = $size / $this->k;

   if ( $this->page > 0 )
   $this->_out( sprintf( 'BT %.3f Tc ET', $size ) );
}

来源：

输出：

针对其他要求的1次更新

如果您需要将数据合并，那么您可以使用：

Sub test_split()
    Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = vbTextCompare
    Dim i&, cl As Range, data As Range, splItem, key
    Set data = Range([B1], Cells(Cells(Rows.Count, "B").End(xlUp).Row, "B")) 'replace `B` by `Q`
    For Each cl In data
        If Not Dic.exists(cl.Value2) Then
            Dic.Add cl.Value2, cl.Offset(, -1).Value2 'replace `-1` by `-16`
        Else
            Dic(cl.Value2) = Dic(cl.Value2) & "," & cl.Offset(, -1).Value2 'replace `-1` by `-16`
        End If
    Next
    Workbooks.Add: i = 1
    For Each key In Dic
        For Each splItem In Split(Dic(key), ",")
            Cells(i, "A").Value2 = key: Cells(i, "B").Value2 = splItem
            i = i + 1
        Next splItem
    Next key
End Sub

来源：

输出：

2针对上次提供的信息进行更新：

如果您有多个单元格用作密钥，那么您可以使用它：

Sub test_combine()
    Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = vbTextCompare
    Dim i&, cl As Range, data As Range, key
    Set data = Range([A1], Cells(Cells(Rows.Count, "A").End(xlUp).Row, "A"))
    For Each cl In data
        If Not Dic.exists(cl.Value2) Then
            Dic.Add cl.Value2, cl.Offset(, 1).Value2
        Else
            Dic(cl.Value2) = Dic(cl.Value2) & "," & cl.Offset(, 1).Value2
        End If
    Next
    Workbooks.Add: i = 1
    For Each key In Dic
        Cells(i, "A").Value2 = key: Cells(i, "B").Value2 = Dic(key)
        i = i + 1
    Next key
End Sub

来源：

输出：

要合并数据，您可以使用：

Sub test_split2()
    Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = vbTextCompare
    Dim i&, cl As Range, data As Range, splItem, key, s$
    Set data = Range([A1], Cells(Cells(Rows.Count, "A").End(xlUp).Row, "A"))
    For Each cl In data
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    'add in `Array()` another cells if required
        s = Join(Array(cl.Offset(, 1).Value2, _
                       cl.Offset(, 2).Value2, _
                       cl.Offset(, 3).Value2, _
                       cl.Offset(, 4).Value2), "|")

    'Currently `s` contains values from columns `B,C,D,E` - 4 values
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        If Not Dic.exists(s) Then
            Dic.Add s, cl.Value2
        Else
            Dic(s) = Dic(s) & "," & cl.Value2
        End If
    Next
    Workbooks.Add: i = 1
    For Each key In Dic
        For Each splItem In Split(Dic(key), ",")
            Cells(i, "A").Value2 = splItem
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            'Change `E` to another column, depending on count of items in `Array()`
            'currently `Array()` contains 4 values from columns `B,C,D,E`
            Range(Cells(i, "B"), Cells(i, "E")) = Split(key, "|")
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            i = i + 1
        Next splItem
    Next key
End Sub

来源：

输出：

Answer 2

你走了。这是一个例子。尝试根据您的需要进行修改

Sub Example()
    Dim ws As Worksheet
    Dim addr As String

    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        addr = ActiveCell.Address

        .Range(addr).Value = "1;2;3;4;5;6"

        .Range(addr).TextToColumns Destination:=.Cells(1, 3), semicolon:=True

        .Range(.Range(addr).Offset(0, 1), .Cells(1, .Cells(1, .Columns.Count).End(xlToLeft).Column)).Copy

        .Cells(2, 2).PasteSpecial Transpose:=True

        ' Uncomment this to clear original cell and transposed results
        ' .Range(.Range(addr), .Cells(.Range(addr).Row, .Cells(1, .Columns.Count).End(xlToLeft).Column)).ClearContents

         .Range(addr).Select
    End With

End Sub

这并没有完全符合您的要求，但会为您提供一种方式的起点，而且可能是最简单的方法。

尝试在空白表中使用它，因为它将创建它自己的示例

通过逗号分隔在excel中拆分行

2 个答案: