Excel VBA组合重复项保持唯一

Question

我有一个数据集，我将其粘贴到表格的下方，并在其中包含它。然后我组合所有重复的行。但是，我在表中添加了两个我想要注释的列。但是，当我稍后组合重复的行时，较新的行的空白单元格会覆盖我在那里的任何音符。 AC和AD列是我的备注单元格。我一直在尝试使用连接方法绕过它来覆盖它，但是我发现这个很棒的宏来组合重复但是我不能在我的生活中找出如何编写一条不会删除组合中的注释列的行处理！任何帮助将不胜感激!!

Option Explicit

Sub removeDupesKeepLast()
Dim d As Long, dDQs As Object, ky As Variant
Dim r As Long, c As Long, vVALs As Variant, vTMP As Variant

'appTGGL bTGGL:=False   'uncomment this when you have finished debugging

Set dDQs = CreateObject("Scripting.Dictionary")
dDQs.comparemode = vbTextCompare

'step 1 - bulk load the values
With Worksheets("Master RFL Pipeline").Range("Table135")   'you should know what worksheet you are on
    With .Cells(1, 1).CurrentRegion 'block of data radiating out from A1
        With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0) 'step off the header row
            vVALs = .Value  'use .Value2 if you do not have dates in unformatted cells
        End With
    End With
End With

'step 2 - build the dictionary
ReDim vTMP(UBound(vVALs, 2) - 1)
For r = LBound(vVALs, 1) To UBound(vVALs, 1)
    For c = LBound(vVALs, 2) To UBound(vVALs, 2)
        vTMP(c - 1) = vVALs(r, c)
    Next c
    dDQs.Item(vVALs(r, 1) & ChrW(8203)) = vTMP
Next r

'step 3 - put the de-duplicated values back into the array
r = 0
ReDim vVALs(1 To dDQs.Count, LBound(vVALs, 2) To UBound(vVALs, 2))
For Each ky In dDQs
    r = r + 1
    vTMP = dDQs.Item(ky)
    For c = LBound(vTMP) To UBound(vTMP)
        vVALs(r, c + 1) = vTMP(c)
    Next c
Next ky

'step 4 - clear the destination; put the de-duplicated values back into the worksheet and reset .UsedRange
With Worksheets("Master RFL Pipeline").Range("Table135")   'you should know what worksheet you are on
    With .Cells(1, 1).CurrentRegion 'block of data radiating out from A1
        With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0) 'step off the header row
            .ClearContents  'retain formatting if it is there
            .Cells(1, 1).Resize(UBound(vVALs, 1), UBound(vVALs, 2)) = vVALs
        End With
    End With
    .UsedRange   'assert the UsedRange property (refreshes it)
End With

dDQs.RemoveAll: Set dDQs = Nothing

appTGGL
End Sub

Public Sub appTGGL(Optional bTGGL As Boolean = True)
With Application
    .ScreenUpdating = bTGGL
    .EnableEvents = bTGGL
    .DisplayAlerts = bTGGL
    .AutoRecover.Enabled = bTGGL   'no interruptions with an auto-save
    .Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
    .CutCopyMode = False
    .StatusBar = vbNullString
End With
Debug.Print Timer
End Sub