如果可以在单独的范围内找到此范围内的日期，则删除行

Question

我有一个 Excel 工作簿，几乎就像一个数据库，我每周都会在其中更新历史数据。使用单独的子，我将导出作为工作表拉入本书。我找到了导出中的唯一日期。然后我查看历史数据，如果历史日期与导出日期之一匹配，我删除历史中的行。最后，我将“导出”复制并粘贴到“历史数据”选项卡中。

下面的代码可以按照我的意愿运行，但是在代码块之后我有一些问题：

Sub AddNewData()

'This will take what's in Export and put it in to Historical

Dim Historical As Worksheet
Dim Export As Worksheet
Dim exportdates As Range

Set Historical = ThisWorkbook.Worksheets("Historical")
Set Export = ThisWorkbook.Worksheets("Export")

'Pulling unique values of dates from this range and pasting to M1:
Export.Range("B2:B" & Export.Cells(Export.Rows.Count, 1).End(xlUp).Row).AdvancedFilter _
    Action:=xlFilterCopy, CopyToRange:=Export.Range("M1"), Unique:=True

'Originally I was thinking I could make this a list of some sort vlookup or match?
'As of now, though, it goes unused...:
Set exportdates = Export.Range("M1:M" & Export.Cells(Export.Rows.Count, 13).End(xlUp).Row)

For r = Historical.Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
    If Historical.Cells(r, 2).Value = exportdates(1, 1).Value Or _
        Historical.Cells(r, 2).Value = exportdates(2, 1).Value Or _
        Historical.Cells(r, 2).Value = exportdates(3, 1).Value _
        Then Historical.Rows(r).Delete
Next

'Copying and pasting Export data to Historical tab
Export.Range("A2:J" & Export.Cells(Export.Rows.Count, 1).End(xlUp).Row).Copy
Historical.Range("A" & Historical.Cells(Historical.Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial xlPasteValues

Application.CutCopyMode = False

End Sub

1) 可以使用 exportdates 范围以某种方式压缩 IF 语句吗？

2) 当我的日期只是每个月的第一天时，这适用于几百行数据，但我也有一个导出日期，我必须与不同的日期匹配带有每日信息的选项卡。那个有数千行。我不相信这个宏会比简单地按日期排序并消除自己更有效吗？我可以像问题 1 那样将 IF 语句更改为更具包容性吗？

谢谢！

Answer 1

当您必须使用 VBA 在 Excel 中删除许多行时，最佳做法是将这些行分配给一个范围并在最后删除该范围。

因此，您的代码应该在这部分进行重构：

For r = Historical.Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
    If Historical.Cells(r, 2).Value = exportdates(1, 1).Value Or _
        Historical.Cells(r, 2).Value = exportdates(2, 1).Value Or _
        Historical.Cells(r, 2).Value = exportdates(3, 1).Value _
        Then Historical.Rows(r).Delete
Next

这是一个可用于重构的简单示例（只需确保在 Range("A1:A20") 中写几次 1 以了解其工作原理：

Public Sub TestMe()

    Dim deleteRange As Range
    Dim cnt         As Long

    For cnt = 20 To 1 Step -1
        If Cells(cnt, 1) = 1 Then
            If Not deleteRange Is Nothing Then
                Set deleteRange = Union(deleteRange, Cells(cnt, 1))
            Else
                Set deleteRange = Cells(cnt, 1)
            End If
        End If
    Next cnt

    deleteRange.EntireRow.Select
    Stop
    deleteRange.EntireRow.Delete

End Sub

一旦您运行代码，它就会在Stop 符号处停止。您会看到要删除的行已被选中。一旦您继续使用 F5，它们就会被删除。考虑删除代码中的 Stop 和 .Select 行。

一些如何加速代码的一般想法：https://stackoverflow.com/a/49514930/5448626