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语句是否可以使用exportdates范围以某种方式压缩？

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

谢谢！

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

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

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

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

1 个答案: