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