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