我可能只是宏觀你,她Ë是:
Sub ConsolidateRows_MultipleColumns()
'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 - should be rightmost column
Const strSep As String = "|" 'string that will separate the consolidated values, use a value that's not in the consolidated strings
'*************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
Columns(strConcat).TextToColumns Destination:=Columns(strConcat).Cells(1, 1), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=strSep
application.ScreenUpdating = True 'reenable ScreenUpdating
End Sub
相關:http://stackoverflow.com/questions/27070873/column-a-has-multiple-values-for-column-b-get-in-rows – pnuts 2014-11-22 04:23:52