串聯，並通過多種細胞VBA的excel

Question

我想通過數據（simular到如下所示）進行迭代存儲在不同的小區和將它們組合成一個新行（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

並拖動功能下降。