Question

我正在尝试构建一个VBA宏，以便删除具有相同ID的行 AND 包含2015年1月1日之前的日期。请参阅屏幕截图:(必须删除红色行）。

我已经开始构建以下宏：

Sub Auto_Open()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'***** Variables declaration *****
Dim LastRow As Integer
Dim EventDate As String
Dim Col As New Collection
Dim itm
Dim i As Long
Dim CellVal As Variant

'***** Find the last row *****
LastRow = Range("A" & Rows.Count).End(xlUp).Row

'***** Conditional Formatting for Statut *****
For i = 2 To LastRow
    CellVal = Sheets("DataSet1").Range("A" & i).Value
    On Error Resume Next
    Col.Add CellVal, Chr(34) & CellVal & Chr(34)
    On Error GoTo 0
Next i

For Each itm In Col
    Debug.Print itm
Next

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True
End Sub

不幸的是，它只列出了不同的ID，我不知道如何选择我想要删除的行。

你可以建议吗？

谢谢你，达明

Answer 1

为什么在找到要删除的行时不存储行号i？

Col.Add CellVal, Chr(34) & CellVal & Chr(34), i

实际上，你已经过了一半。在该循环中，确定ID和日期是否与您的模式匹配，如果匹配，则存储rownumber。然后在第二个循环中，从头到尾循环（步骤-1），删除集合中的每一行。

修改
保持简单。不要使用对象的引用，而是对象。 “让它发挥作用，使它正确，快速” - 按顺序。当代码执行必要时，这仍然是代码中的内容：

For Row = 2 To LastRow CellDate = CDate(S.Cells(i, 2).Value) If (CellDate < TestDate) Then If Not D.Exists(S.Cells(i, 1).Value) Then D.Add S.Cells(i, 1).Value Else ' is duplicate! willdeleted.Add Row End If End If Next Row For Row = willdeleted.Count To 1 Step -1 Rows(willdeleted(i)).EntireRow.Delete Next Row

不要使用字典作为行号（willdeleted）！一个简单的列表可以做，无论是Array（）还是Collection。字典不保留添加元素的顺序。要删除的rownumbers列表必须从最低到最高排序，以便能够从表格底部删除行。

Answer 2

我更改了一些代码并添加了我的代码。请检查代码，请说出您的想法。如果您无法解决问题，请提供更多信息。

    Sub Auto_Open()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    '***** Variables declaration *****
    Dim LastRow As Integer
    Dim EventDate As String
    Dim Col As New Collection
    Dim itm
    Dim i As Long
    Dim CellVal As Variant
    Dim CellObj As Range


    'to check if cell exist in list earlier
    Dim D As Dictionary
    ' if same key exist in list then add it to willbedeleted list
    Dim willdeleted As Dictionary
    Dim S As Worksheet
    Dim Cnt As Integer
    Dim CellDate As Date
    Dim TestDate As Date

    '***** Find the last row *****
    LastRow = Range("A1").End(xlDown).Row

    Set S = Worksheets("Dataset1")
    Set D = New Dictionary
    Set willdeleted = New Dictionary


    TestDate = CDate("01/01/2015")

    '***** Conditional Formatting for Statut *****
    For i = 2 To LastRow
        Set CellObj = S.Cells(i, 1)

        On Error Resume Next

        CellDate = CDate(CellObj.Offset(0, 1).Value)
        If (CellDate < TestDate) Then
            If (Not D.Exists(CellObj.Value)) Then
               D.Add CellObj.Value, CellObj
            Else
               willdeleted.Add CellObj.Address(RowAbsolute:=True, ColumnAbsolute:=True), CellObj
            End If
        End If

        On Error GoTo 0
    Next i


    a = willdeleted.Items
    For i = 0 To willdeleted.Count - 1
        CellObj = a(i)
        Debug.Print "#" & CellObj.Row & " row deleted.. : " & CellObj.Value & ", " & CellObj.Offset(0, 1).Value
        Rows(CellObj.Row).EntireRow.Delete
    Next i


    End Sub

VBA - 删除具有相同ID且基于日期的行

2 个答案: