求和和删除重复行

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 的情况下，它不会被注意到）。

关于“删除重复项”，请看这里 - Delete all duplicate rows Excel vba。