VBAを使用して2つの列の値を比較する

Question

このコードでは、列A（コードソース）と列B（コードroc）を比較し、列AのコードソースごとにコードCを列挙し、列Dでは、A = Bの場合は、列Gのコードregateと列Hのアドレスを使用して、EおよびFに戻します。 これを使用しているコードは、シャットダウンするまでブロックされ、誰かがあなたに感謝することができれば正確な結果は得られません。 ここに私がAとB、CとDから必要とする結果の写真です

Sub copy_lignes() 

    Dim DerLigA, DerLigB As Long, i, j As Long 

    DerLigA = Sheets("sheet3").Range("A" & Rows.Count).End(xlUp).Row 
    DerLigB = Sheets("sheet3").Range("B" & Rows.Count).End(xlUp).Row 
    For i = 2 To DerLigA 
     For j = 2 To DerLigB 
     If Sheets("sheet3").Range("A" & i) = Sheets("sheet3").Range("B" & j) Then 

      Sheets("sheet3").Range("A" & i).Copy Destination:=Sheets("sheet3").Range("E" & i) 
      Sheets("sheet3").Range("B" & i).Copy Destination:=Sheets("sheet3").Range("F" & i) 
      Sheets("sheet3").Range("C" & i).Copy Destination:=Sheets("sheet3").Range("G" & i) 
      Sheets("sheet3").Range("D" & i).Copy Destination:=Sheets("sheet3").Range("H" & i) 

     End If 
     Next j 
    Next i 

End Sub 

Answer 1

多分これは何で、以下のコードを試してみてくださいあなたの投稿の意味：

Sub copy_lignes() 

Dim DerLigA, DerLigB As Long, i, j As Long 
Dim PasteRow As Long 

' optimize speed performance 
Application.ScreenUpdating = False 

With Sheets("Sheet3") 

    DerLigA = .Cells(.Rows.Count, "A").End(xlUp).Row 
    DerLigB = .Cells(.Rows.Count, "B").End(xlUp).Row 
    PasteRow = 2 

    For i = 2 To DerLigA 
     For j = 2 To DerLigB 
      If .Range("A" & i) = .Range("B" & j) Then 
       .Range("A" & i).Copy Destination:=.Range("E" & PasteRow) 
       .Range("B" & j & ":D" & j).Copy Destination:=.Range("F" & PasteRow) 
       PasteRow = PasteRow + 1 
      End If 
     Next j 
    Next i 
End With 

' restore settings 
Application.ScreenUpdating = True 

End Sub 

Answer 2

それはあなたがわずか数行でタブに必要なことかもしれないが、それは次のようになります。

Sub copy_lignes() 

Dim DerLigA As Long 
Dim DerLigB As Long 
Dim i As Integer 
Dim j As Integer 
i = 2 
j = 2 
DerLigA = Sheets("sheet3").Range("A" & Rows.Count).End(xlUp).Row 
DerLigB = Sheets("sheet3").Range("B" & Rows.Count).End(xlUp).Row 
For i To DerLigA 
    For j To DerLigB 
     If Sheets("sheet3").Range("A" & i) = Sheets("sheet3").Range("B" & j) Then 

      Sheets("sheet3").Range("A" & i).Copy Destination:=Sheets("sheet3").Range("E" & i) 
      Sheets("sheet3").Range("B" & i).Copy Destination:=Sheets("sheet3").Range("F" & i) 
      Sheets("sheet3").Range("C" & i).Copy Destination:=Sheets("sheet3").Range("G" & i) 
      Sheets("sheet3").Range("D" & i).Copy Destination:=Sheets("sheet3").Range("H" & i) 

     End If 
    Next j 
Next i 
End Sub