比较和查找2张相应的2列中的重复项
我想比较（500）并在2张表格中find重复的日志，并将不匹配的行复制到另一张纸上，将匹配从另一张复制到第三张，并从原始纸张中删除匹配的logging。
我有3个工作表（结果，主列表，跟随Ups）“结果”每天更新500条logging，并添加到“主列表”，重复行添加到“跟进”
都有类似的列标题A到O.
我想比较列B（唯一）和工作表“结果”的列A到“主列表”stream将是 – 将“结果”列B中的第一个单元格值与“主列表”的列B单元格值匹配如果匹配发现 – 如果find匹配，则将“结果”的列A与“主列表”的列A单元值进行比较将列A的“主列表”的匹配行复制到“下一个可用的FOllow Ups”行并将匹配在search循环结束时最后删除“结果”中的行
否则，如果匹配未find，则检查“结果”列B中的下一个值直到最后一条logging
当整个search结束时，删除在“结果”中find的匹配logging，并将所有被遗漏的logging复制到“主列表”中的下一个可用表格行中
我有点卡住，不想长时间运行，寻求专家的帮助，尽可能最短和最快的代码。 这里有一些代码已经编写和工作，但不能很好地工作。 在此先感谢您的帮助。
Set sht1 = xlwb.Worksheets("results") Set sht4 = xlwb.Worksheets("Master List") Set sht5 = xlwb.Worksheets("Follow Ups") For i = 2 To sht1.Range("A1").SpecialCells(xlCellTypeLastCell).Row For j = 2 To sht4.Range("A1").SpecialCells(xlCellTypeLastCell).Row If sht1.Cells(i, 2) = sht4.Cells(j, 2) And sht1.Cells(i, 1) = sht4.Cells(j, 1) Then 'sht4.Rows(j).Copy ' sht5.Activate 'sht5.Cells(1, sht5.Range("A1").SpecialCells(xlCellTypeLastCell).Row).Select sht4.Rows(j).Copy _ Destination:=sht5.Cells(sht5.Range("A1").SpecialCells(xlCellTypeLastCell).Row + 1, 1) 'sht1.Rows(i).Delete 'i = i - 1 End If Next j Next i sht1.Range("A2:O" & sht1.Range("A1").SpecialCells(xlCellTypeLastCell).Row).Copy _ Destination:=sht4.Cells(sht4.Range("A1").SpecialCells(xlCellTypeLastCell).Row, 1) 如果您拥有“大量”数据，那么在这里执行您的操作将会导致严重的性能问题。 问题是，每次将数据从Excel移动到VBA时，都是一个开销。 这里你应该做的是将所有的数据一次拷贝到数组中（参见http://www.cpearson.com/excel/ArraysAndRanges.aspx ），并在VBA中完成所有的逻辑操作，而不用触摸你的Excel工作表。
如果您仍然需要性能提升，则应查找字典（请参阅VBA是否具有字典结构？ ）。
阅读这篇文章： https ： //msdn.microsoft.com/en-us/library/office/ff726673.aspx特别是“单一操作中读写大数据块”
考虑SQL解决scheme（假设您使用Excel for PC），因为Excel可以使用Jet / ACE SQL引擎（Windows .dll文件）在工作簿上运行ODBC连接。 没有循环或如果/然后跨越单元的逻辑用于可扩展，有效的解决scheme。 基本上你会运行两个查询：
- MATCHES：结果和MasterList工作表上的内部联接查询，并将结果附加到Follow-Ups上
SELECT r.* FROM [Results$] r INNER JOIN [MasterList$] m ON r.ColA = m.ColA AND r.ColB = m.ColB
- NON-MATCHES：结果和MasterList工作表上的左连接null查询，并将结果附加到MasterList
SELECT r.* FROM [Results$] r LEFT JOIN [MasterList$] m ON r.ColA = m.ColA AND r.ColB = m.ColB WHERE m.ColA IS NULL;
VBA脚本（包含驱动程序/提供程序版本的两个连接）
Sub RunSQL() On Error GoTo ErrHandle Dim conn As Object, rst As Object Dim strConnection As String, strSQL As String Dim i As Integer Dim fLastRow As Integer, mLastRow As Integer Set conn = CreateObject("ADODB.Connection") Set rst = CreateObject("ADODB.Recordset") ' Hard code database location and name ' strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _ ' & "DBQ=C:\Path\To\Workbook.xlsm;" strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _ & "Data Source='C:\Path\To\Workbook.xlsm';" _ & "Extended Properties=""Excel 8.0;HDR=YES;"";" ' OPEN DB CONNECTION conn.Open strConnection '''''''''''''''''''''''''''''''''''' ''' FOLLOW-UPS (MATCHED) DATA '''''''''''''''''''''''''''''''''''' strSQL = " SELECT r.* FROM [RESULTS$] r" _ & " INNER JOIN [MASTERLIST$] m" _ & " ON r.ColA = m.ColA AND r.ColB = m.ColB" ' OPEN QUERY RECORDSET rst.Open strSQL, conn ' COPY DATA TO WORKSHEET fLastRow = Worksheets("FOLLOW-UPS").Cells(Worksheets("FOLLOW-UPS") _ .Rows.Count, "A").End(xlUp).Row Worksheets("FOLLOW-UPS").Range("A" & fLastRow + 1).CopyFromRecordset rst rst.Close '''''''''''''''''''''''''''''''''''' ''' MASTERLIST (UNMATCHED) DATA '''''''''''''''''''''''''''''''''''' strSQL = " SELECT r.* FROM [RESULTS$] r" _ & " LEFT JOIN [MASTERLIST$] m" _ & " ON r.ColA = m.ColA AND r.ColB = m.ColB" _ & " WHERE m.ColA IS NULL;" ' OPEN QUERY RECORDSET rst.Open strSQL, conn ' COPY DATA TO WORKSHEET mLastRow = Worksheets("MASTERLIST").Cells(Worksheets("MASTERLIST") _ .Rows.Count, "A").End(xlUp).Row Worksheets("MASTERLIST").Range("A" & mLastRow + 1).CopyFromRecordset rst rst.Close conn.Close MsgBox "Successfully processed SQL queries!", vbInformation Exit Sub ErrHandle: MsgBox Err.Number & " = " & Err.Description, vbCritical Exit Sub End Sub
演示
下面是使用Shakespearan字符的Dropbox xlsm文件演示，其中MasterList带有stream行的女性angular色，结果是小批量的女性/男性angular色。 按SQLbutton运行macros。 一旦查询被处理，女性（匹配）输出到Follow-Ups和男性（不匹配）附加到MasterList。 确保在stringODBC连接中调整工作簿path。