Excel宏將列B中每個ID行的多個行與換行連接在一起

Question

此問題位於Excel .xls文件中。

簡單的用法：

A列有一行。 B列有5行。 列B中的5行需要合併爲一行，由換行符分隔。

我有一個巨大的.xls文檔，其中A列中有大量的ID。 平均有3到10行的任何屬於每列的行。

如何知道哪列B行屬於哪個列A？ 由細胞的定位。 一列一行可能有5列B列在其右側。

我沒有任何VBA經驗。 我已經查找了宏和函數，但沒有找到任何符合此問題的運氣。

編輯： 我現在想弄清楚如何讓腳本忽略與列A和B列

編輯之間的一個一對一的映射再行 - 2012年6月20日： 現在我可以附加圖片了，下面是我試圖獲得的圖片截圖。
布萊恩和馬克的行應該被忽略，而斯科特和蒂姆將他們的值複製過來。

編輯： 拆散塔A中，使用代碼安迪供給，然後後來使用該VB腳本執行特技：

子mergeA（ ）
For i = 2 To Cells（65535，1）.End（xlUp）.Row
如果IsE MPTY（細胞（I，1））接着範圍（將細胞（I - 1，1），將細胞（I，1））。合併
接着
結束子

即VB腳本把細胞在A列到一起
我沒有劇本，它來自這個網頁：
http://www.vbforums.com/showthread.php?t=601304

Answer 1

這將改變左邊到右邊的輸出中顯示的數據：

Option Explicit 

Sub Make_Severely_Denormalized() 
    Const HEADER_ROWS As Long = 1 
    Const OUTPUT_TO_COLUMN As Long = 3 
    Const DELIMITER As String = vbNewLine 
    Dim A_Range As Range 
    Dim B_Range As Range 
    Dim A_temp As Range 
    Dim B_temp As Range 
    Dim B_Cell As Range 
    Dim Concat As String 

On Error GoTo Whoops 
    Set A_Range = Range("A1").Offset(HEADER_ROWS) 
    Do While Not A_Range Is Nothing 
    Set B_Range = A_Range.Offset(0, 1) 

    ' some helper ranges 
    If A_Range.Offset(1, 0).Value = "" Then 
     Set A_temp = Range(A_Range, A_Range.End(xlDown).Offset(-1, 0)) 
    Else 
     Set A_temp = A_Range.Offset(1, 0) 
    End If 
    Set B_temp = Range(B_Range, B_Range.End(xlDown)).Offset(0, -1) 

    ' determine how high "B" is WRT no change in "A" 
    Set B_Range = Range(B_Range, B_Range.Resize(_ 
     Application.Intersect(A_temp, B_temp, ActiveSheet.UsedRange).Count)) 

    ' loop through "B" and build up the string 
    Concat = "" 
    For Each B_Cell In B_Range 
     Concat = Concat & B_Cell.Value & DELIMITER 
    Next 
    Concat = Left(Concat, Len(Concat) - Len(DELIMITER)) 

    ' do the needful 
    A_Range.Offset(0, OUTPUT_TO_COLUMN - 1).Value = Concat 

    ' find the next change in "A" 
    If A_Range.Offset(1, 0).Value = "" Then 
     Set A_Range = Application.Intersect(A_Range.End(xlDown), ActiveSheet.UsedRange) 
    Else 
     Set A_Range = A_Range.Offset(1, 0) 
    End If 
    Loop 
    Exit Sub 
Whoops: 
    MsgBox (Err & " " & Error) 
    Stop 
    Resume Next 
End Sub