формула 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