EXCEL：合并多行macros
我需要一个MACRO来查看COL A的所有实例，并将COL B的所有值组合到一行中，同时删除进程中的重复项。 添加一个逗号是一个加号。
我不认识任何VBA，但如果有人善意解释，我很乐意学习。 这不是我所需要的第一个VBA解决scheme。 谢谢！
我需要的例子：
COL A COL B 100 ---- PC 245 100 ---- PC 246 100 ---- PC 247 101 ---- PC 245 101 ---- PC 246 101 ---- PC 247 INTO
COL A COL B 100 ---- PC 245, PC 246, PC 247 101 ---- PC 245, PC 246, PC 247
这些数据将进入地图，所以我需要连接工具提示文本。 任何帮助表示赞赏。 谢谢！
PS：我需要的是一个MACRO。 我不需要的是一个枢轴表。
由于版主已删除此代码，因此重新发布。 @帐单蜥蜴，在重新确定之前，你能评论我的答案有什么问题吗？
Sub ConsolidateRows() 'takes rows and consolidate one or many cells, based on one or many cells matching with above or below rows. Dim lastRow As Long, i As Long, j As Long Dim colMatch As Variant, colConcat As Variant '**********PARAMETERS TO UPDATE**************** Const strMatch As String = "A" 'columns that need to match for consolidation, separated by commas Const strConcat As String = "B" 'columns that need consolidating, separated by commas Const strSep As String = ", " 'string that will separate the consolidated values '*************END PARAMETERS******************* application.ScreenUpdating = False 'disable ScreenUpdating to avoid screen flashes colMatch = Split(strMatch, ",") colConcat = Split(strConcat, ",") lastRow = range("A" & Rows.Count).End(xlUp).Row 'get last row For i = lastRow To 2 Step -1 'loop from last Row to one For j = 0 To UBound(colMatch) If Cells(i, colMatch(j)) <> Cells(i - 1, colMatch(j)) Then GoTo nxti Next For j = 0 To UBound(colConcat) Cells(i - 1, colConcat(j)) = Cells(i - 1, colConcat(j)) & strSep & Cells(i, colConcat(j)) Next Rows(i).Delete nxti: Next application.ScreenUpdating = True 'reenable ScreenUpdating End Sub
以下代码要求您添加对“Microsoft脚本运行时”的引用。
VBA Editor->Tools->References, Find and select Microsoft Scripting Runtime
它可能使用“集合”而不是“Dictionarys”。 我只是喜欢字典。
代码将读取活动工作表（“Do循环”）并复制数据（删除过程中的重复项）
然后清除表单上的所有数据。
然后循环收集的数据并将其输出到现在为空的工作表（“For Each”循环）
Sub Cat() Dim Data As Dictionary Dim Sheet As Worksheet Set Sheet = ThisWorkbook.ActiveSheet Set Data = New Dictionary Dim Row As Integer Dim Key As Variant Dim Keys() As Variant Dim Value As Variant Dim Values() As Variant Dim List As String Row = 1 Do If Data.Exists(CStr(Sheet.Cells(Row, 1))) Then If Not Data(CStr(Sheet.Cells(Row, 1))).Exists(CStr(Sheet.Cells(Row, 2))) Then Data(CStr(Sheet.Cells(Row, 1))).Add (CStr(Sheet.Cells(Row, 2))), True End If Else Data.Add CStr(Sheet.Cells(Row, 1)), New Dictionary Data(CStr(Sheet.Cells(Row, 1))).Add (CStr(Sheet.Cells(Row, 2))), True End If Row = Row + 1 If IsEmpty(Sheet.Cells(Row, 1)) Then Exit Do End If Loop Sheet.Cells.ClearContents Keys = Data.Keys Row = 1 For Each Key In Keys Values = Data(Key).Keys Sheet.Cells(Row, 1) = Key List = "" For Each Value In Values If List = "" Then List = Value Else List = List & ", " & Value End If Next Value Sheet.Cells(Row, 2) = List Row = Row + 1 Next Key End Sub