答案 0 :(得分:1)
我有这个宏用于此目的。您可以根据需要进行调整:
Sub ConsolidateRows_MultipleCells()
'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, lColDest As Long
'**********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 lDest As Long = 2 'starting column for the consolidated items
'*************END PARAMETERS*******************
application.ScreenUpdating = False 'disable ScreenUpdating to avoid screen flashes
colMatch = Split(strMatch, ",")
colConcat = Split(strConcat, ",")
Cells(1, 1).CurrentRegion.Sort key1:=Cells(1, colMatch(0)), order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
lastRow = range("A" & Rows.Count).End(xlUp).Row 'get last row
lColDest = lDest
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
lColDest = lDest
GoTo nxti
End If
Next
For j = 0 To UBound(colConcat)
range(Cells(i, strConcat), Cells(i, 1).End(xlToRight)).Copy Cells(i - 1, 1).End(xlToRight).Offset(, 1)
lColDest = lColDest + 1
Next
Rows(i).Delete
nxti:
Next
application.ScreenUpdating = True 'reenable ScreenUpdating
End Sub