连接和迭代多个单元格VBA excel

我想遍历存储在不同单元格中的数据（类似于下图所示），并将它们合并成一个单独的单元格（chr（10））。 需要导入到一个单元格中的数据量将会改变。

2991 19391 423 435 436 

代码需要遍历整个工作表，而不pipe是否有换行符。 所需的格式是：

  2991 - all three cells would be combined into one cell in the next column to this one. 19391 423 -Line space, this will need to be taken into account and is the seperator of data. 26991 - all four cells would be combined into one cell in the next column to this one. 19331 424 6764 

以下是我到目前为止所取得的结果，它将当前行左侧的列合并起来，这是错误的。

 Sub ConcatColumns() Do While ActiveCell <> "" 'Loops until the active cell is blank. ActiveCell.Offset(0, 1).FormulaR1C1 = _ ActiveCell.Offset(0, -1) & chr(10) & ActiveCell.Offset(0, 0) ActiveCell.Offset(1, 0).Select Loop End Sub 

Answer 1

你可以用这个代码来达到上面的效果

 Sub Main() Dim i As Long Dim c As Range For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1 Dim strBuilder As String Set c = Range("A" & i) If Not IsEmpty(c) And i <> 1 Then strBuilder = c & Chr(10) & strBuilder ElseIf i = 1 Then strBuilder = c & Chr(10) & strBuilder c.Offset(0, 1) = Left(strBuilder, Len(strBuilder) - 1) strBuilder = vbNullString Else c.Offset(1, 1) = Left(strBuilder, Len(strBuilder) - 1) strBuilder = vbNullString End If Next i End Sub 

Answer 2

我认为这可以使用UDF完成。

就像是

 Public Function JoinValues(rng As Range) As String Dim cell As Range Dim str As String For Each cell In rng If cell.Value <> "" Then str = str & cell.Value & Chr(10) End If Next cell If Len(str) > 1 Then JoinValues = Left(str, Len(str) - 1) End Function 

然后用法将=JoinValues(A1:A10)在单元格中以join值。 您还必须更改目标单元格中​​的单元格格式，以允许为了使其正常工作而打包文本。

---

假设你的值从单元格A2开始input

 =IF(A1="",joinvalues(OFFSET(A2,0,0,MATCH(TRUE,INDEX(ISBLANK(A2:A10000),0,0),0)-1)),"") 

在B2中拖动该function。