☰

有效删除多个 Excel 表中的重复记录

tag-icon • tag-icon microsoft-excel vba
有效删除多个 Excel 表中的重复记录

我有一本包含 2 张工作表的工作簿。工作表 1 有 3 列（1A、1B 和 1C），工作表 2 有 2 列（2A 和 2B）。现在，如果 1A 和 1B 与工作表 2 中的任何行匹配（即 1A=2A 和 1B=2B），我需要从工作表 1 中删除行。因此，基本上暂时忘记 1C，并从工作表 1 中删除与工作表 2 中的行匹配的所有行。

一种方法是编写一个宏，获取工作表 1 的每一行，并将 1A 与所有 2A 值进行比较。如果找到匹配项，则将相应的 1B 与 2B 进行比较，如果它们也相同，则从工作表 1 中删除该行。考虑到每个工作表都有超过 100,000 行，我认为这会使比较次数过多并且需要很长时间。

有没有更有效的方法来做到这一点？

答案1

这是 VBa，没有撤消，因此在执行此操作之前，请先备份您的文件！

Option Explicit

Sub WalkThePlank()
Application.ScreenUpdating = False

Dim startRow As Integer
startRow = 1

Dim row As Integer
row = startRow

Dim bRow As Integer

'sharks below cap'ain
Do While (Worksheets("Sheet1").Range("A" & row).Value <> "")

    Dim aVal As String
    Dim bVal As String

    aVal = Worksheets("Sheet1").Range("A" & row).Value
    bVal = Worksheets("Sheet1").Range("B" & row).Value


    'I see thy booty
    bRow = startRow

    Do While (Worksheets("Sheet2").Range("A" & bRow).Value <> "")

    Dim aVal2 As String
    Dim bVal2 As String

    aVal2 = Worksheets("Sheet2").Range("A" & bRow).Value
    bVal2 = Worksheets("Sheet2").Range("B" & bRow).Value

    If (aVal = aVal2 And bVal = bVal2) Then

        Worksheets("Sheet1").Rows(row).Delete ' we found a traitor, feed em to the sharks
        row = row - row
        Exit Do

    End If

    bRow = bRow + 1

    Loop

row = row + 1
Loop

End Sub

截图：

工作表1

在此处输入图片描述

工作表2

在此处输入图片描述

运行宏后，Sheet1 看起来像（Sheet2 保持不变）

在此处输入图片描述

如何在 MS Office 中添加 VBA？

相关内容