VBAは他のワークブックと一致して値を取得します

Question

私はVBAをとても新しくしています。同じファイルの場所に保存された2つの別のブック（ワークブック1とワークブック2）

私は何を探しているのですか？列Cがワークブック1に入力されているときに、ワークブック2でその番号を検索するマクロが必要です（列A）。

一致するものが見つかった場合、私は、ブック1にコピーする列C、D、E及びワークブック2におけるGからの対応する値 Here is the values populated in Workbook1, then matched in Workbook2Here is the expected results, with the matched values populating Workbook1

がワークブック2で開くことがないであろうしたいですユーザーは、Workbook1のボタンをクリックするだけで、データが入力されます。

私は現在、この作業を持っていますが、大幅に開くワークブック1.

任意のヘルプは高く評価されて鈍化しているVlookupsと。

Answer 1

これをFile1で使用しているシートのコードに入れて、シート名とパスを編集します。あなたはボタンや何かを押す必要はありません、マクロは、列Cのデータが変更されFile2のデータをFile1にロードするとアクティブになります。

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim KeyCells As Range 
Dim Sheet1, Sheet2 As Worksheet 
Dim CellChanged As Integer 
Dim Path, File As String 
Dim LastRow As Long 

Path = "C:\Users\User\Desktop\2.xlsx" 'Edit Path File2 
File = Right$(Path, Len(Path) - InStrRev(Path, "\")) 

Set Sheet1 = ThisWorkbook.Worksheets("Tabelle1") 'Edit Sheet File1 

Set KeyCells = Range("C:C") 

If Not Application.Intersect(KeyCells, Range(Target.Address)) _ 
     Is Nothing Then 

    CellChanged = Target.Row 

    Workbooks.Open (Path) 
    Set Sheet2 = Workbooks(File).Worksheets("Tabelle1") 'Edit Sheet of File2 

    LastRow = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row 

    For i = 1 To LastRow 
     If Sheet1.Range("C" & CellChanged).Value = Sheet2.Range("A" & i) Then 
      Sheet1.Range("D" & CellChanged).Value = Sheet2.Range("B" & i).Value 'Date 
      Sheet1.Range("E" & CellChanged).Value = Sheet2.Range("C" & i).Value 'Amount 
      Sheet1.Range("F" & CellChanged).Value = Sheet2.Range("F" & i).Value 'Payee 
      Sheet1.Range("G" & CellChanged).Value = Sheet2.Range("D" & i).Value 'Pol Number 
      Exit For 
     End If 
    Next i 
    Workbooks(File).Close savechanges:=False 
End If 
End Sub 

EDIT： マクロ複数の編集（H1内の最後のセル変更店）とボタンで開始します。また、エラーハンドルが追加されました。

Sub WithButton() 
Dim KeyCells As Range 
Dim Sheet1, Sheet2 As Worksheet 
Dim CellChanged As Integer 
Dim Path, File As String 
Dim LastRow, LastData As Long 
Dim Found As Boolean 

On Error GoTo Handle 

      Set Sheet1 = ThisWorkbook.Worksheets("Tabelle1") 'Edit Sheet File1 

      If Sheet1.Range("H1").Value = "" Then 
    Sheet1.Range("H1").Value = 0 
    CellChanged = Sheet1.Cells(Rows.Count, "C").End(xlUp).Row 
End If 

If Sheet1.Cells(Rows.Count, "C").End(xlUp).Row > Sheet1.Range("H1").Value Then 
    Path = "C:\Users\L4R21D\Desktop\2.xlsx" 'Edit Path File2 
    File = Right$(Path, Len(Path) - InStrRev(Path, "\")) 

    CellChanged = Sheet1.Range("H1").Value + 1 
    Workbooks.Open(Path) 
      Set Sheet2 = Workbooks(File).Worksheets("Tabelle1") 'Edit Sheet of File2 

       LastRow = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row 
    LastData = Sheet1.Cells(Rows.Count, "C").End(xlUp).Row 

    For i = 1 To LastRow 
     If Sheet1.Range("C" & CellChanged).Value = Sheet2.Range("A" & i) Then 
      Sheet1.Range("D" & CellChanged).Value = Sheet2.Range("B" & i).Value 
      Sheet1.Range("E" & CellChanged).Value = Sheet2.Range("C" & i).Value 
      Sheet1.Range("F" & CellChanged).Value = Sheet2.Range("F" & i).Value 
      Sheet1.Range("G" & CellChanged).Value = Sheet2.Range("D" & i).Value 
      Found = True 
     End If 
     If Found = True Or i = LastRow Then 
      If CellChanged = LastData Then 
       Exit For 
      End If 
      If Found = True Then 
       Found = False 
       CellChanged = CellChanged + 1 
      End If 
      i = 0 
     End If 
    Next i 
    Workbooks(File).Close savechanges:=False 
       Sheet1.Range("H1").Value = CellChanged 
End If 
Exit Sub 
Handle: 
    MsgBox("Error") 
End Sub