将数据从列合并到行

我有一个电子表格：

Company 1 | ID1
Company 1 | ID2
Company 1 | ID3
Company 2 | ID4
Company 2 | ID5
Company 2 | ID6
Company 3 | ID7
Company 3 | ID8
Company 3 | ID9

我需要将每个公司合并为一行，并将其所有ID合并到右侧的列中。每个公司可以有不同数量的ID。

最终结果将如下所示：

Company 1 | ID1 | ID2 | ID3
Company 2 | ID4 | ID5 | ID6
Company 3 | ID7 | ID8 | ID9

我该怎么做？最好使用VBA。

该单一公式解决方案假定每个公司具有相同的行数：

D2在表的其余部分中输入以下公式，然后按ctrl-enter / copy-paste / fill-down＆right键：

=""&INDEX($A:$B,ROW($D$2)+3*INT(ROW()-ROW($D$2))+MAX(0,COLUMN()-COLUMN($D$2)-1),2-(COLUMN()=COLUMN($D$2)))

请注意，此公式将适用于每个公司的任何（相同）行数，并且将正确调整是否添加/删除行或列。

但是，如果该表所在的表被复制/剪切并粘贴到其他位置，则该公式将中断。在$D$2国家需要改变到新表位置的左上角单元格的数据相匹配，以使其再次正常工作。

如果每个公司的行数可变，则所需的单个公式为：

=IFERROR(IF(COLUMN()=COLUMN($D$2),""&INDEX($A:$A,MATCH(D1,$A:$A,0)+COUNTIF($A:$A,D1)),INDEX(INDEX($B:$B,MATCH($D2,$A:$A,0)):INDEX($B:$B,MATCH($D2,$A:$A,0)+COUNTIF($A:$A,$D2)-1),COLUMN()-COLUMN($D$2))),"")

这是VBA的替代方案：

'============================================================================================
' Module     : <any standard module>
' Version    : 0.1.0
' Part       : 1 of 1
' References : N/A
' Source     : https://superuser.com/a/1335738/763880
'============================================================================================
Option Explicit

Public Sub UnPivot()
       Dim ¡ As Long

  Const s_SourceColumns As String = "A:B"
  Const s_TargetColumn As String = "D"
  Const b_HasHeader As Boolean = True

  Dim lngSourceRows As Long
  lngSourceRows = ActiveSheet.Columns(s_SourceColumns).Cells(Rows.Count, 1).End(xlUp).Row + CLng(b_HasHeader)
  Dim varSource As Variant
  varSource = ActiveSheet.Columns(s_SourceColumns).Resize(RowSize:=lngSourceRows + 1).Offset(RowOffset:=-CLng(b_HasHeader)).Value2
  Dim idxNewCompany As Long: idxNewCompany = LBound(varSource, 1)
  Dim strNewCompany As String: strNewCompany = varSource(idxNewCompany, 1)
  Dim varUnPivotedData() As Variant
  ReDim varUnPivotedData(1 To lngSourceRows)
  varUnPivotedData(1) = strNewCompany
  Dim celNextTargetStart As Range
  Set celNextTargetStart = ActiveSheet.Columns(s_TargetColumn).Resize(RowSize:=1).Offset(RowOffset:=-CLng(b_HasHeader))
  Application.ScreenUpdating = False
  For ¡ = LBound(varSource, 1) To UBound(varSource, 1) - 1
    varUnPivotedData(¡ - idxNewCompany + 2) = varSource(¡, 2)
    If varSource(¡ + 1, 1) <> strNewCompany Then
      ReDim Preserve varUnPivotedData(1 To ¡ - idxNewCompany + 2)
      celNextTargetStart.Resize(ColumnSize:=UBound(varUnPivotedData)).Value2 = varUnPivotedData
      Set celNextTargetStart = celNextTargetStart.Offset(RowOffset:=1)
      idxNewCompany = ¡ + 1
      strNewCompany = varSource(idxNewCompany, 1)
      ReDim varUnPivotedData(1 To lngSourceRows)
      varUnPivotedData(1) = strNewCompany
    End If
  Next ¡
  Application.ScreenUpdating = True

End Sub

只需更改代码顶部的常量以适合您的情况。

这个怎么运作：

• 选择A2：A11并将范围命名为COMPANY。
• 选择B2：B11并命名范围ID。

• 在单元格C2中编写此数组公式，以生成公司的唯一列表：

  {=INDEX($A$2:$A$11, MATCH(0, COUNTIF($C$1:C1, $A$2:$A$11), 0))}

注意： 使用Ctrl + Shift + Enter结束上述书面公式，然后填写下来。

• 在单元格D2中编写此数组公式，然后按Ctrl + Shift + Enter并先填充，然后向下填充。

  {=IFERROR(INDEX(IDs,SMALL(IF(Company=$C2,ROW(IDs)-MIN(ROW(IDs))+1),COLUMNS($C$2:C2))),"")}

注意，

• 如果每个公司的ID数不固定，则此公式将顺利运行。

• 您将获得“列”中的Ids列表，如屏幕截图所示。