用逗號分隔的VBA拼接單元

Question

我對VBA編碼真的很陌生。

問題我已經是這樣的：

B60，D60，F60，H60（等）的細胞具有這種格式的不同的值：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行就可以做到這一點。我真的試過編輯這段代碼，但是我不明白其中的任何內容......有人可以幫我解決嗎？真的很感激。

Answer 1

這將幫助你。僅適用於第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 

如果你有不同數量在每個小區逗號分隔值，則需要更改線路：

For i = 0 To 2 

到

For i = 0 to Ubound(numArray) 

編輯

固定代碼可在每列之間使用1個空白列o f數據。