Excel 公式交叉引用 2 张表，从一张表中删除重复项

Question

这与

有关

Excel / VBA Remove duplicate rows by cross referencing 2 different sheets then deleting 1 row

我似乎无法让任何 VBA 运行良好或足够快地运行 100 行。

Excel 是否有一个公式可以通过交叉引用另一张工作表从一张工作表中删除重复项？

感谢您的所有帮助。

Answer 1

这是一个更快的 VBA 解决方案，它使用了一个字典对象。如您所见，它仅在工作表 A 和工作表 B 中循环一次，而您的原始解决方案的运行时间与“工作表 A 中的行数”*“工作表 B 中的行数”成正比。

Option Explicit
Sub CleanDupes()
    Dim wsA As Worksheet
    Dim wsB As Worksheet
    Dim keyColA As String
    Dim keyColB As String
    Dim rngA As Range
    Dim rngB As Range
    Dim intRowCounterA As Integer
    Dim intRowCounterB As Integer

    keyColA = "A"
    keyColB = "B"

    intRowCounterA = 1
    intRowCounterB = 1

    Set wsA = Worksheets("Sheet A")
    Set wsB = Worksheets("Sheet B")

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    Do While Not IsEmpty(wsA.Range(keyColA & intRowCounterA).Value)
        Set rngA = wsA.Range(keyColA & intRowCounterA)
        If Not dict.Exists(rngA.Value) Then
            dict.Add rngA.Value, 1
        End If
        intRowCounterA = intRowCounterA + 1
    Loop

    intRowCounterB = 1
    Do While Not IsEmpty(wsB.Range(keyColB & intRowCounterB).Value)
        Set rngB = wsB.Range(keyColB & intRowCounterB)
        If dict.Exists(rngB.Value) Then
             wsB.Rows(intRowCounterB).Delete
             intRowCounterB = intRowCounterB - 1
        End If
        intRowCounterB = intRowCounterB + 1
    Loop
End Sub

Answer 2

您可以使用 ADO 和 Excel 做很多事情。

Dim cn As Object
Dim rs As Object
Dim wb As Workbook
Dim sSQL As String
Dim sFile As String
Dim sCon As String
Dim sXLFileToProcess As String
Dim i

sXLFileToProcess = "Book1z.xls"

sFile = Workbooks(sXLFileToProcess).FullName

''Note that if HDR=No, F1,F2 etc are used for column names,
''if HDR=Yes, the names in the first row of the range
''can be used.
''This is the Jet 4 connection string, you can get more
''here : http://www.connectionstrings.com/excel

sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sFile _
    & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"

''Late binding, so no reference is needed

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open sCon

'' In this example, the column header for column F is F, see notes
'' above on field (column) names. It also assumes that the sheets to
'' be merged have the same column headers in the same order
'' It would be safer to list the column heards rather than use *.

sSQL = sSQL & "SELECT b.Key,b.b,b.c,b.d,b.e FROM [SheetB$] As B " _
            & "LEFT JOIN [SheetA$] As A " _
            & "ON B.Key=A.Key " _
            & "WHERE A.Key Is Null"

rs.Open sSQL, cn, 3, 3

Set wb = Workbooks.Add

With wb.Worksheets("Sheet1")
    For i = 1 To rs.Fields.Count
        .Cells(1, i) = rs.Fields(i - 1).Name
    Next

    .Cells(2, 1).CopyFromRecordset rs
End With

''Tidy up
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing