Excel宏用于连接A列中每个ID行的B列中的多行和换行符

Question

此问题出现在Excel .xls文件中。

最简单的用例：

A列有一行。 B列有5行。 B列中的5行需要合并为一行，由换行符分隔。

我有一个巨大的.xls文档，其中A列中有大量ID。 平均每行有3到10行，属于每一行A行。

如何知道哪些B列属于哪一列？ 通过细胞的定位。 一列A行可能在其右侧有5列B行。

我没有任何VBA经验。 我一直在寻找宏和函数，但没有找到任何与此问题相符的运气。

编辑： 我现在试图弄清楚如何让脚本忽略在A列和B列之间具有一对一映射的行。

再次编辑 - 2012年6月20日： 现在我可以附加图像，这里是我想要获取的图像的屏幕截图。
应该忽略Brian和Mark的行，而Scott和Tim将他们的值复制过来。

编辑： 使用Andy提供的代码取消合并A列，然后使用此VB脚本可以解决问题：

  

Sub mergeA（）
   对于i = 2到单元格（65535,1）.End（xlUp）.Row
   如果IsEmpty（Cells（i，1））则Range（Cells（i - 1,1），Cells（i，1））。合并
   接下来
  结束Sub

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