Excel公式交叉参考2张，从一张纸上删除重复

这与…有关

Excel / VBA通​​过交叉引用2个不同的工作表删除重复的行，然后删除1行

我似乎无法让任何VBA工作良好或足够快的几百行。

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

感谢你的帮助。

Answer 1

这是一个更快的VBA解决scheme，利用字典对象。 正如你所看到的，它只在表单A和表单B中循环一次，而你原来的解决scheme的运行时间与表单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,bb,bc,bd,be 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