求和并删除重复行

Question

我需要一个显示DriverName和Duration列的表，每隔一列都可以删除。必须删除所有重复项，并且应将每个驱动程序的持续时间相加。

我一直在努力解决这个问题，我一直试图使用的代码如下。它需要在Vba中完成。

如果有人可以提供帮助，我会非常感激。

Sub MG02Sep59
Dim Rng As Range, Dn As Range, n As Long, nRng As Range
Set Rng = Range(Range("D2"), Range("D" & Rows.Count).End(xlUp))
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
    If Not .Exists(Dn.Value) Then
        .Add Dn.Value, Dn
    Else
        If nRng Is Nothing Then Set nRng = _
       Dn Else Set nRng = Union(nRng, Dn)
        .Item(Dn.Value).Offset(, 3) = .Item(Dn.Value).Offset(, 3) +    Dn.Offset(, 3)
    End If
Next
If Not nRng Is Nothing Then nRng.EntireRow.Delete
End With
End Sub

Answer 1

一般来说，你使用字典的想法可能很好。但是，我没有看到你如何传递密钥，因此这是一个快速的解决方案：

Option Explicit

Public Sub TestMe()

    Dim colCount    As Long
    Dim myCell      As Range
    Dim counter     As Long

    colCount = Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
                xlPart, SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Column

    For counter = colCount To 1 Step -1
        If Cells(4, counter) <> "DriverName" And Cells(4, counter) <> "Duration" Then
            Columns(counter).Delete
        End If
    Next counter       

End Sub

代码假定表的标题总是第4行。一旦这个假设准备就绪，在Excel VBA- Finding the last column with data的帮助下，我们用数据定义最后一列，然后从它开始循环到第1列，检查Cells(4, counter)是不是DriverName还是Duration。如果不是，我们删除它。

您可以考虑稍后声明工作表，只要当前代码始终引用活动表 - Declaring variable workbook / Worksheet vba。

将所有内容设置为Union Range的想法确实更好，因为这样删除只进行一次而且速度更快（但是，在少数100列的情况下，它不会引人注意）。

关于＆＃34;删除重复项＆＃34;，请看一下 - Delete all duplicate rows Excel vba。