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

Question

我想遍历存储在不同单元格中的数据（类似于下面显示的数据），并将它们组合成一个由新行分隔的单个单元格 (chr(10))。 需要导入一个单元格的数据量会发生变化。

2991
19391
423
435
436

代码需要遍历整个工作表，而不考虑任何换行符。要求的格式是：

    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) 来连接值。您还必须更改目标单元格中​​的单元格格式以允许换行文本才能正常工作。

---

假设您的值从单元格 A2 开始输入

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

在 B2 中并向下拖动函数。