2セットのデータを比較して、欠損値を別のシートに貼り付けます。

Question

したがって、1000+の行を持つマスターシートと、同じデータを持つべき別のシートがあります。しかし、現実的には、マスターからいくつかのものが欠落している場合があり、クエリ実行に欠けているものがあります。
簡単にするために、一意のIDが列Bにあるとしましょう。ここに私のコードがありますが、それは非常に遅く、単方向比較しか行いません。

私の理想的なコードは、少しスムーズに動作し、マスターとクエリの両方から不足しているデータを私に与えるものです。

私が質問している方法に間違っていますか教えてください。

Sub FindMissing() 

    Dim lastRowE As Integer 
    Dim lastRowF As Integer 
    Dim lastRowM As Integer 
    Dim foundTrue As Boolean 


    lastRowE = Sheets("Master").Cells(Sheets("Master").Rows.Count, "B").End(xlUp).Row 
    lastRowF = Sheets("Qry").Cells(Sheets("Qry").Rows.Count, "B").End(xlUp).Row 
    lastRowM = Sheets("Mismatch").Cells(Sheets("Mismatch").Rows.Count, "B").End(xlUp).Row 



    For i = 1 To lastRowE 
     foundTrue = False 
     For j = 1 To lastRowF 
      If Sheets("Master").Cells(i, 2).Value = Sheets("Qry").Cells(j, 2).Value Then 
       foundTrue = True 
       Exit For 
      End If 
     Next j 
     If Not foundTrue Then 
      Sheets("Master").Rows(i).Copy Destination:= _ 
      Sheets("Mismatch").Rows(lastRowM + 1) 
      lastRowM = lastRowM + 1 
     End If 
    Next i 

End Sub 

Answer 1

ワークシートのセルをループしないでください。すべての値をバリアント配列に集め、メモリー内で処理します。私はミスマッチのワークシートに戻ってそれらを置く前に、結果のサイズを変更しますヘルパー関数を追加しましたので、

Option Explicit 

Sub YouSuckAtVBA() 

    Dim i As Long, mm As Long 
    Dim valsM As Variant, valsQ As Variant, valsMM As Variant 

    With Worksheets("Master") 
     valsM = .Range(.Cells(1, "B"), .Cells(.Rows.Count, "B").End(xlUp)).Value2 
    End With 

    With Worksheets("Qry") 
     valsQ = .Range(.Cells(1, "B"), .Cells(.Rows.Count, "B").End(xlUp)).Value2 
    End With 

    ReDim valsMM(1 To (UBound(valsM, 1) + UBound(valsQ, 1)), 1 To 2) 
    mm = 1 
    valsMM(mm, 1) = "value" 
    valsMM(mm, 2) = "missing from" 

    For i = LBound(valsM, 1) To UBound(valsM, 1) 
     If IsError(Application.Match(valsM(i, 1), valsQ, 0)) Then 
      mm = mm + 1 
      valsMM(mm, 1) = valsM(i, 1) 
      valsMM(mm, 2) = "qry" 
     End If 
    Next i 

    For i = LBound(valsQ, 1) To UBound(valsQ, 1) 
     If IsError(Application.Match(valsQ(i, 1), valsM, 0)) Then 
      mm = mm + 1 
      valsMM(mm, 1) = valsQ(i, 1) 
      valsMM(mm, 2) = "master" 
     End If 
    Next i 

    valsMM = helperResizeArray(valsMM, mm) 

    With Worksheets("Mismatch") 
     With .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) 
      .Resize(UBound(valsMM, 1), UBound(valsMM, 2)) = valsMM 
     End With 
    End With 

End Sub 

Function helperResizeArray(vals As Variant, x As Long) 
    Dim arr As Variant, i As Long 

    ReDim arr(1 To x, 1 To 2) 

    For i = LBound(arr, 1) To UBound(arr, 1) 
     arr(i, 1) = vals(i, 1) 
     arr(i, 2) = vals(i, 2) 
    Next i 

    helperResizeArray = arr 
End Function 

あなたは2次元配列の最初のランクのサイズを変更することはできません。