Excel 用逗号分隔的VBA剪接细胞

我对VBA编码非常陌生

我的问题是：

B60、D60、F60、H60（etc）单元格在此格式中具有不同的值：x、y、z （x、y和z可以是数字0-10） 我想把它拼接成：

B60 = x
B61 = y
B62 = z
D60 = x2
D61 = y2
D62 = z2

等等

我发现了以下代码：

Dim objRegex
Dim Z
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
Z = Range([a1], Cells(Rows.Count, "b").End(xlUp)).Value2
ReDim Y(1 To 2, 1 To 1000)
For lngRow = 1 To UBound(Z, 1)
'Split each string by ","
tempArr = Split(Z(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 2, 1 To lngCnt + 1000)
Y(1, lngCnt) = Z(lngRow, 1)
Y(2, lngCnt) = objRegex.Replace(strArr, "$1")
Next
Next lngRow
'Dump the re-ordered range to columns C:D
[a1].Resize(lngCnt, 2).Value2 = Application.Transpose(Y)

---

但这对我不太管用。我只需要第60行就可以了。我真的试过编辑这段代码，但我一点都不懂。。。有人能帮我吗？非常感谢。

这将为您带来好处。仅适用于第60行，不会覆盖现有值，因此可以检查准确性。在每个单元格中仅适用于3个逗号分隔的值

'Required declaration for the arrays to be 0-based in VBA.
Option Base 0

'Routine to split out the values and place them vertically under the original cell.
Sub SplitItOut()
    'Variable to hold the contents of the cell in question.
    Dim contents
    'Column number of the column to start searching for data in.
    Dim startColumn As Integer
    'Counter variable used to keep track of the current column.
    Dim columnCounter As Integer
    'Array to store the comma-separated values in, after they have been separated from their commas.
    Dim numArray() As String
    Dim i As Integer

    columnCounter = 0

    'Starting column is 2 which is "B".
    startColumn = 2
    'Read in the initial contents of "B60". Cells function is using (row 60, column 2) style notation.
    contents = Cells(60, startColumn).Value

    'Keep looping until there is nothing but an empty string in the contents variable.
    Do While contents <> ""
        'Split out the numbers in the cell and store them in an array.
        numArray = Split(contents, ",", -1)
        'Loop through the 3 entries in the array.
        For i = 0 To 2
            'Place each entry in successive rows below the original cell.
            'The Trim function is used to remove any potential extra spaces from the number.
            Cells(61 + i, startColumn + columnCounter).Value = Trim(numArray(i))
        Next
        'Move to the next column.
        columnCounter = columnCounter + 1
        'Read in its contents.
        contents = Cells(60, startColumn + columnCounter).Value
        'If the contents are empty, move to the next column.
        If contents = "" Then
            columnCounter = columnCounter + 1
        End If
        'If the next column is also empty, the loop will exit, otherwise it will continue with the new contents of the current column.
        contents = Cells(60, startColumn + columnCounter).Value
    Loop
End Sub

到

编辑

---

修正了代码，使每列数据之间有一个空白列。

在代码中添加一些注释肯定会对OP有所帮助（特别是如果他对找到的代码不太理解），然后你的答案肯定会使upvotesWow失去意义。我几乎明白了没有您的注释代码的含义。在你添加了评论之后，你做了什么就变得非常清楚了。我试过了，效果很好！我唯一更改的是columncounter+1到columncounter+2，因为我每次跳过一列（该列不是空的，但有不同的数据）。非常感谢，肯定非常有帮助。@user1646031很高兴能提供帮助。您可以通过单击复选标记将此答案标记为“已接受”答案。欢迎来到StackOverflow@Bob：excel的用户朋友们，谢谢你们的注释代码。你让世界变得更美好：D-投票支持编辑和评论code@Stewbob. 我希望你不介意我用另一个（也许很简单的）问题来打扰你。有时两列为空，但数据在这两个空列之后继续。但是，循环将停止。我试图将最后一列定义为finalCol=Cells（1，Columns.Count）.End（xlToLeft）.column，但很难将其集成到代码中。

For i = 0 To 2

For i = 0 to Ubound(numArray)