Question

我想比较（500）并在2张纸内找到重复的每日记录，并将不匹配的行复制到另一张纸，将匹配从另一张复制到第三张，然后从原始纸张中删除匹配的记录。

我有3个工作表（结果，主列表，跟随Ups）“结果”每天更新500条记录，并添加到“主列表”，重复行添加到“跟进”

所有类似的列都标题为A到O.

我想比较B列（唯一）和工作表“结果”的A列到“主列表” 流量将是 - 将“结果”的B列中的第一个单元格值与“主列表”的B列单元格值匹配如果找到匹配项 - 将“结果”的列A与“主列表”的列A单元格值进行比较如果找到匹配将匹配行从A列的“主列表”复制到O到下一个可用的“FOllow Ups”行并在搜索循环结束时将“结果”中的匹配行标记为最后删除

否则如果未找到匹配项检查“结果”B列中的下一个值，直到最后一个记录

整个搜索结束时删除“结果”中找到的匹配标记记录将所有左侧记录复制到“主列表”中的下一个可用表格行

我有点卡住，不想长时间循环运行，寻找最短，最快的代码的专家帮助。这里有一些已经编写和工作的代码，但效果不佳。在此先感谢您的帮助。

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)

Answer 1

如果你有很多＆＃34;做你在这里做的事情会给你带来很大的性能问题。数据的。问题是，每次将数据从Excel移动到VBA都是一种开销。你应该在这里做的是将所有数据一次复制到数组（参见http://www.cpearson.com/excel/ArraysAndRanges.aspx）并在VBA中完成所有逻辑，而无需触及Excel工作表。

如果您仍然需要提升性能，则应该查看词典（请参阅Does VBA have Dictionary Structure?）。

阅读本文：https://msdn.microsoft.com/en-us/library/office/ff726673.aspx 特别是在单个操作中读取和写入大块数据＆＃34;

Answer 2

考虑使用SQL解决方案（假设您使用Excel for PC），因为Excel可以使用Jet / ACE SQL引擎（Windows .dll文件）在工作簿上运行ODBC连接。此处不使用循环或if / then逻辑跨单元格来实现可扩展，高效的解决方案。基本上你会运行两个查询：

MATCHES：结果和主列表工作表上的内部联接查询，其结果附加到Follow-Ups

    SELECT r.* FROM [Results$] r
    INNER JOIN [MasterList$] m
    ON r.ColA = m.ColA AND r.ColB = m.ColB

NON-MATCHES：结果和MasterList工作表上的左连接空查询，其结果附加到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 file演示，其中MasterList包含流行的女性角色，结果是少量的女性/男性角色。按SQL按钮运行宏。处理完查询后，女性（匹配）输出到Follow-Ups，男性（不匹配）附加到MasterList。请务必在字符串ODBC连接中调整工作簿路径。

比较并找到2张相应列中的重复项

2 个答案: