Excel - 重构重复的行

时间:2015-09-02 17:26:04

标签: excel

请参阅下面的示例。我所拥有的是左侧,我想要的是右侧。有没有简单的方法在excel中进行此操作?

enter image description here

1 个答案:

答案 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
相关问题