Vba 用逗号分隔法拆分excel中的行

我需要在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代码实现这一点吗

---

提前谢谢

给你。这是一个例子。尝试根据您的需要修改它

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

这并没有完全满足你的需求，但会给你一个起点，一种可能是最简单的方法

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

您可以使用此选项：

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

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

Sub test_combine2()
    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
            Cells(i, "A").Value2 = Dic(key)
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            'Change `E` to another column, depending on count of items in `Array()`
            'currently in array 4 values from columns `B,C,D,E`
            Range(Cells(i, "B"), Cells(i, "E")) = Split(key, "|")
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            i = i + 1
    Next key
End Sub

资料来源：

输出：

---

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

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

Sub test_combine2()
    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
            Cells(i, "A").Value2 = Dic(key)
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            'Change `E` to another column, depending on count of items in `Array()`
            'currently in array 4 values from columns `B,C,D,E`
            Range(Cells(i, "B"), Cells(i, "E")) = Split(key, "|")
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            i = i + 1
    Next key
End Sub

资料来源：

输出：

---

2根据上次提供的信息进行更新：

如果您有多个电池用作钥匙，则可以使用：

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

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

Sub test_combine2()
    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
            Cells(i, "A").Value2 = Dic(key)
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            'Change `E` to another column, depending on count of items in `Array()`
            'currently in array 4 values from columns `B,C,D,E`
            Range(Cells(i, "B"), Cells(i, "E")) = Split(key, "|")
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            i = i + 1
    Next key
End Sub

资料来源：

输出：

要合并回数据，可以使用以下方法：

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

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

Sub test_combine2()
    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
            Cells(i, "A").Value2 = Dic(key)
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            'Change `E` to another column, depending on count of items in `Array()`
            'currently in array 4 values from columns `B,C,D,E`
            Range(Cells(i, "B"), Cells(i, "E")) = Split(key, "|")
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            i = i + 1
    Next key
End Sub

资料来源：

输出：

---

到目前为止，您尝试了什么？如果没有什么，谷歌就是你的朋友。这是谷歌的第一个结果，它给出了你的答案。我试着用谷歌搜索。textToColumns的问题是。。。wel这是对列而不是对行；）尝试将其录制为宏。它会为你做VBAi、 e.按下记录，然后调用数据：数据工具功能区中的文本到列功能…@BennyNiemeijer使用文本到列功能，然后转置结果。简单；）否则，您将使用

Do

loop@Benny，你赢了我5秒…你，先生，是真正的MVP！非常感谢！还有两个问题，而不是A列和B列，我的真实工作表有A-Q。我还能用这个代码吗？第二：我怎样才能再次交换它们？@BennyNiemeijer是的，你可以使用这段代码，我用代码标记了行，在这些行中你需要进行替换以将其应用于真实数据，我还发布了代码以将数据合并回来，请参见更新的postWorks，如果我将B改为Q，将-1改为-16，它只复制Q列，但我想复制B-Q列，怎么做？非常感谢你迄今为止的帮助@BennyNiemeijer您在最初的评论中指定，您需要的不是A&B，而是A-Q（您的真实数据），但您的最后一条评论显示您需要B-Q，因此，您需要的不是-16，而是-15。换言之，

offset（，-15）

将为您提供单元格的位置，该位置在

Q列中单元格位置的第15个单元格之前

对不起，我认为我们彼此不太了解，我已经用屏幕截图编辑了我的问题，以了解我实际需要的内容。再次非常感谢！