[英]Concatenate value in each column based on cell value
如果您要求 VBA 解决方案,请尝试下一个代码。 它将处理尽可能多的Value
列,并在最后一列之后返回两列的处理结果。 使用 arrays,即使对于大范围,代码也会非常快:
Sub ConcatenateWithValues()
Dim sh As Worksheet, lastR As Long, lastCol As Long, arr, arrH, arrFin
Dim strConc As String, i As Long, j As Long
Set sh = ActiveSheet 'use here the sheet you need
lastR = sh.Range("A" & sh.Rows.count).End(xlUp).row 'last row on column A:A
lastCol = sh.cells(1, sh.Columns.count).End(xlToLeft).Column 'last column on the first row
arr = sh.Range("A1", sh.cells(lastR, lastCol)).Value 'place the whole range in an array, for faster iteration
arrH = sh.Range("A1", sh.cells(1, lastCol)).Value 'Place headers in an array
ReDim arrFin(1 To UBound(arr), 1 To 2) 'Redim the array to contain the processing result
arrFin(1, 1) = arrH(1, 1): arrFin(1, 2) = "Concatenate_Value"'Place the headers in the array
For i = 2 To UBound(arr)
For j = 2 To lastCol 'build the necessary concatenation
If arr(i, j) <> "" Then strConc = strConc & arrH(1, j) & ":" & arr(i, j) & ";"
Next
arrFin(i, 1) = arr(i, 1): arrFin(i, 2) = left(strConc, Len(strConc) - 1) 'remove the last ";" character
strConc = "" 'reinitialize the string keeping row concatenation
Next i
'Drop the processed array content at once:
sh.cells(1, lastCol + 2).Resize(UBound(arrFin), 2).Value = arrFin
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.