第1ワークブックの値と第2ワークブックのカラムを一致させ、特定のセルをコピー

Question

第1ワークブックの値と第2ワークブックのデータのカラムを一致させ、第1ワークブックの特定のセルをコピーして貼り付けます。 2番目のワークブックに特定のセル（一致データと同じ行）を追加します。ここで

は、私がこれまでに作ってみたが、それは動作しないコードがあり、実行時エラー1004を返します：アプリケーション定義またはオブジェクト定義のエラーを。

Dim FindNo As String 
Dim X As Long, LastRow As Long 
Dim FoundCell As Range 
Dim FColumn As Integer, FRow As Integer 
Dim WB1 As Workbook, SHT1 As Worksheet 
Dim WB2 As Workbook, SHT2 As Worksheet 

Application.ScreenUpdating = False 

    Set WB1 = ThisWorkbook 
    Set WB2 = Workbooks.Open("Z:\ISO MTSO DOCUMENTS (New Templates)\Incident & Accident Monitoring (2016 and 2017)\Incident Monitoring 2016 and 2017.xlsx") 
    Set SHT1 = WB1.Sheets("F-IMS-11") 
    Set SHT2 = WB2.Sheets("2017") 

    FindNo = SHT1.Range("Q1").Value 
    LastRow = SHT2.Range("C" & Rows.Count).End(xlUp).Row 

For X = 3 To LastRow 

    If SHT2.Cells(X, "C") = FindNo Then 

     FRow = FoundCell.Row 
     FColumn = FoundCell.Column 

    SHT2.Range(Cells(FColumn + 14, FRow)) = SHT1.Cells(13, 1) 
    SHT2.Range(Cells(FColumn + 15, FRow)) = SHT1.Cells(7, 6) 
    SHT2.Range(Cells(FColumn + 17, FRow)) = SHT1.Cells(46, 2) 
    SHT2.Range(Cells(FColumn + 18, FRow)) = SHT1.Cells(58, 2) 
    SHT2.Range(Cells(FColumn + 19, FRow)) = SHT1.Cells(58, 13) 

    End If 

    Application.CutCopyMode = False 

Next X 

SHT2.Columns(17).WrapText = True 
SHT2.Columns(20).WrapText = True 
SHT2.Columns(21).WrapText = True 

WB2.Save 
WB2.Close 

Application.ScreenUpdating = True 

それは私が本当にVBAで良い背景を持っていない、と私はコードのほとんどを変更しようとしたとして、提案を聞くのは素晴らしいだろう。

Answer 1

あなたはそれを利用する前にFoundCellを設定していないので、あなたは右If SHT2.Cells(X, "C") = FindNo Then後にいくつかのSet FoundCell = SHT2.Cells(X, "C")を追加する必要があります。しかし、一致したセルの行と列のインデックスがそれぞれXと3であることをすでに知っているので、クロス参照の無駄です。

さらに、あなたは（... workbook、worksheetrange）オブジェクトを参照するWith-End With構文を採用したいとシンプルなドット（.）によって、そのメソッドやプロパティにアクセスすることができます。これは、適切なオブジェクト参照をより詳細に制御し、宣言と使用の多くの変数からあなたを解放します。最後に

これらのオブジェクトは、あなたがどのようなラインで次のようにリファクタリング

Option Explicit 

Sub main() 
    Dim FindNo As String 
    Dim X As Long 
    Dim val1 As Variant, val2 As Variant, val3 As Variant, val4 As Variant, val5 As Variant 

    Application.ScreenUpdating = False 

    With ThisWorkbook.Sheets("F-IMS-11") '<--| reference Worksheet object directly from "WB1" workbook 
     FindNo = .Range("Q1").Value 
     val1 = .cells(13, 1) 
     val2 = .cells(7, 6) 
     val3 = .cells(46, 2) 
     val4 = .cells(58, 2) 
     val5 = .cells(58, 13) 
    End With 

    With Workbooks.Open("Z:\ISO MTSO DOCUMENTS (New Templates)\Incident & Accident Monitoring (2016 and 2017)\Incident Monitoring 2016 and 2017.xlsx") '<--| open and reference wanted "WB2" workbook 
     With .Sheets("2017") '<--| reference its "2017" worksheet 
      For X = 3 To .Range("C" & .Rows.Count).End(xlUp).Row '<--| loop through its column "C" cells from row 3 down to last not empty one 
       If .cells(X, "C") = FindNo Then 
        .cells(X, 17) = val1 
        .cells(X, 18) = val2 
        .cells(X, 20) = val3 
        .cells(X, 21) = val4 
        .cells(X, 22) = val5 
       End If 
      Next X 
      Range("Q:Q , T:T, U:U").WrapText = True 
     End With 
     .Close True 
    End With 

    Application.ScreenUpdating = True 
End Sub 

Answer 2

X = 3 to LastRowループでは、FoundRow範囲オブジェクトを使用して変数を設定していますが、FoundRowは設定されていません。

はこれでそのループを交換してみてください：

For X = 3 To LastRow 

    If SHT2.Cells(X, "C") = FindNo Then 

     Set FoundCell = SHT2.Cells(X, "C") 
     FRow = FoundCell.Row 
     FColumn = FoundCell.Column 
     Set FoundCell = Nothing 
    SHT2.Range(Cells(FColumn + 14, FRow)) = SHT1.Cells(13, 1) 
    SHT2.Range(Cells(FColumn + 15, FRow)) = SHT1.Cells(7, 6) 
    SHT2.Range(Cells(FColumn + 17, FRow)) = SHT1.Cells(46, 2) 
    SHT2.Range(Cells(FColumn + 18, FRow)) = SHT1.Cells(58, 2) 
    SHT2.Range(Cells(FColumn + 19, FRow)) = SHT1.Cells(58, 13) 

    End If 

    Application.CutCopyMode = False 

Next X