将行整理，整理并转换为列

我有下面的表格

Id Letter 1001 A 1001 H 1001 H 1001 H 1001 B 1001 H 1001 H 1001 H 1001 H 1001 H 1001 H 1001 A 1001 H 1001 H 1001 H 1001 B 1001 A 1001 H 1001 H 1001 H 1001 B 1001 B 1001 H 1001 H 1001 H 1001 B 1001 H 1001 A 1001 G 1001 H 1001 H 1001 A 1001 B 1002 B 1002 H 1002 H 1002 B 1002 G 1002 H 1002 B 1002 G 1002 G 1002 H 1002 B 1002 G 1002 H 1002 H 1002 G 1002 H 1002 H 1002 H 1002 H 1002 H 1002 M 1002 N 1002 G 1002 H 1002 H 1002 M 1002 M 1002 A 1002 H 1002 H 1002 H 1002 A 1002 B 1002 B 1002 H 1002 H 1002 H 1002 B 1002 H 1002 H 1002 H 1002 A 1002 A 1002 A 1002 H 1002 H 1002 H 1002 H 1002 B 1002 H 1003 G 1003 H 1003 H 1003 N 1003 M 

我想转置它使第一列中的每个不同的id和第二列中的所有字母与原始表中的每个空白行一个空格：

 1001 AHHH BHHH HHH AHHHB AHHHB BHHHB H AGHHAB 1002 BHHB GH BGGH BGHH GHH HHHMN GHHMM AHHHAB BHHH BHHHAA AHHHHB H 1003 GHHNM 

我有大约100个不同的ID。 我试着用TRANSPOSE和TRIM做一个公式。 我也尝试了一个macros，VLOOKUP似乎是最简单的方法，但无法find如何

Answer 1

您不能在事先不知道范围的情况下使用本地工作表函数连接一系列单元格（又名字母 ）。 由于你的string集合有随机数的元素，VBA循环方法似乎是解决这个问题的最好方法（如果不是唯一的话）。 循环可以沿着工作表函数根本无法执行的方式进行确定。

点击Alt + F11 ，当Visual Basic编辑器（又名VBE）打开时，立即使用下拉菜单插入►模块（ Alt + I ， M ）。 将下面的一个或两个粘贴到标题为Book1 – Module1（Code）的新窗格中。

连接由空格分隔的string组：

 Sub concatenate_and_transpose_to_delim_string() Dim rw As Long, lr As Long, pid As Long, str As String Dim bPutInColumns As Boolean With ActiveSheet lr = .Cells(Rows.Count, 1).End(xlUp).row .Cells(1, 4).Resize(1, 2) = Array("Id", "Letters") pid = .Cells(2, 1).Value For rw = 2 To lr If IsEmpty(.Cells(rw, 1)) Then str = str & Chr(32) If pid <> .Cells(rw + 1, 1).Value Then .Cells(Rows.Count, 4).End(xlUp).Offset(1, 0) = pid .Cells(Rows.Count, 4).End(xlUp).Offset(0, 1) = str End If ElseIf pid <> .Cells(rw, 1).Value Then pid = .Cells(rw, 1).Value str = .Cells(rw, 2).Value Else str = str & .Cells(rw, 2).Value End If Next rw .Cells(Rows.Count, 4).End(xlUp).Offset(1, 0) = pid .Cells(Rows.Count, 4).End(xlUp).Offset(0, 1) = str End With End Sub 

要将string组拆分为列：

 Sub concatenate_and_transpose_into_columns() Dim rw As Long, lr As Long, nr As Long, pid As Long, str As String With ActiveSheet lr = .Cells(Rows.Count, 1).End(xlUp).row .Cells(1, 4).Resize(1, 2) = Array("Id", "Letters") For rw = 2 To lr If IsEmpty(.Cells(rw, 1)) Then .Cells(nr, Columns.Count).End(xlToLeft).Offset(0, 1) = str str = vbNullString ElseIf pid <> .Cells(rw, 1).Value Then pid = .Cells(rw, 1).Value nr = .Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).row .Cells(nr, 4) = pid str = .Cells(rw, 2).Value Else str = str & .Cells(rw, 2).Value End If Next rw .Cells(nr, Columns.Count).End(xlToLeft).Offset(0, 1) = str End With End Sub 

点击Alt + Q返回到您的工作表。 在A1中以Id开头的活动工作表上的示例数据，点击Alt + F8打开macros对话框并运行macros。

concatenate_and_transpose_to_delim_string的结果：

concatenate_and_transpose_into_columns的结果：

结果将写入从D2开始的单元格中。 如果事先没有任何重要的东西可能会被覆盖，那么最好的办法可能是最好的。

附录：

我原来曲解您的请求，并将string组拆分为单独的列。 我已经通过一个补充程序纠正了这个问题，这个程序更接近你的要求描述，但保留了两个变体供其他人参考。

Answer 2

这个选项合并了数组。 从性能angular度来看，将工作表中的数据一次读入数组要比将数据直接写入VBE并将结果写回工作表要快得多。

 Sub transposing() Const sDestination As String = "D2" Dim ar1() As Variant Dim ar2() As Variant Dim i As Long 'counter ar1 = ActiveSheet.Range("A2:B" & ActiveSheet.UsedRange.Rows.Count).Value ReDim ar2(1 To 1, 1 To 2) ar2(1, 1) = ar1(1, 1): ar2(1, 2) = ar1(1, 2) For i = 2 To UBound(ar1, 1) If ar1(i, 1) = ar2(UBound(ar2, 1), 1) Then ar2(UBound(ar2, 1), 2) = ar2(UBound(ar2, 1), 2) & ar1(i, 2) ElseIf ar1(i, 1) = vbNullString Then ar2(UBound(ar2, 1), 2) = ar2(UBound(ar2, 1), 2) & " " Else ar2 = Application.Transpose(ar2) ReDim Preserve ar2(1 To 2, 1 To UBound(ar2, 2) + 1) ar2 = Application.Transpose(ar2) ar2(UBound(ar2, 1), 1) = ar1(i, 1) ar2(UBound(ar2, 1), 2) = ar2(UBound(ar2, 1), 2) & ar1(i, 2) End If Next ActiveSheet.Range(sDestination).Resize(UBound(ar2, 1), UBound(ar2, 2)).Value = ar2 End Sub 

结果将如下所示：

Const sDestination As String = "D2"表示输出的开始。 将其更改为您想要的任何单元格。

Answer 3

对于这样的任务，Microsoft向Excel 2016添加了“获取和转换”。为了在早期版本中使用此function，您必须使用Power Query加载项。 M码很短：

 let Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content], FillIdDown = Table.FillDown(Source,{"Id"}), ReplaceNull = Table.ReplaceValue(FillIdDown,null," ",Replacer.ReplaceValue,{"Letter"}), Transform = Table.Group(ReplaceNull, {"Id"}, {{"Count", each Text.Combine(_[Letter])}}) in Transform 

您的数据应该位于“Table1”中。 https://www.dropbox.com/s/bnvchofmpvd048v/SO_AggregateCollat​​eAndTransposeColsIntoRows.xlsx?dl=0