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

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) 可以使用导出日期范围以某种方式压缩该 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 行。

一些关于如何加速代码的一般想法：

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

If Date in this range can be found in separate range, delete row

vba

excel

ms-office

date-range