前提・実現したいこと
二つの別々のブックを参照して、第3の新しいブックにリストを作成したいです。
dataファイルに格納されているinputWbのA2からA最終行と、別ブックのRefdataのA2からA245を比較し、inputWbに記載がない項目があれば、項目を追加するためのコードです。
不足情報があれば追記させていただきますので、皆様のアドバイスをいただければ幸いです。
何卒よろしくお願い致します。
発生している問題・エラーメッセージ
以下のように記載すると、For each AddListでエラー1004「アプリケーション定義またはオブジェクト定義のエラーです。」と表示されます。
該当のソースコード
Sub CreateList() '----- Read book from \data folder Dim inputWb As Workbook ‘--dataフォルダ内に格納されているブック Dim outputWb As Workbook '--新しく作成するブック Dim Refdata As Workbook '--参照ブック Dim inputSh As Worksheet Dim RefdataSh As Worksheet Dim inputFileName, inputFilePath As String inputFileName = Dir(ThisWorkbook.Path + "\data*.xlsx") inputFilePath = ThisWorkbook.Path + "\data\" + inputFileName Dim RefdataFilePath As String RefdataFilePath = ThisWorkbook.Path + "\Reference Data.xlsx" Set inputWb = Workbooks.Open(inputFilePath) Set outputWb = Workbooks.Add Set inputSh = inputWb.Sheets(1) Set Refdata = Workbooks.Open(RefdataFilePath) Set RefdataSh = Refdata.Sheets(1) Dim LastRow As Long LastRow = Range("A" & Rows.Count).End(xlUp).Row Dim r As Long Dim AddList For r = 2 To 245 ‘—inputWbのA2からA最終行と、RefdataブックのA2からA245までの項目をそれぞれ参照 For Each AddList In inputSh.Range("A2:" & LastRow) ‘—ここでエラー1004「アプリケーション定義またはオブジェクト定義のエラーです。」 ‘—もしinputWbにRefdataの項目がなければ If InStr(inputCountry.Value, RefdataSh.Range("A" & "r").Value) = 0 Then '—RefdataのA248からG251に記載されているフォーマットをinputWbの最終行に追加する RefdataSh.Range("A248 : G251").Copy outputWb.Sheets(1).Range("A" & LastRow).PasteSpecial Paste:=xlPasteColumnWidths ‘—コピー&ペーストしたフォーマットのA列に、inputWbとRefdataを比較し、inputWbに漏れていた情報(RefdataのA及びB列)の文字列を追記する。 outputWb.Sheets(1).Range("A" & LastRow - 3) = Refdata.Range("A" & "r").Value outputWb.Sheets(1).Range("A" & LastRow - 2) = Refdata.Range("A" & "r").Value outputWb.Sheets(1).Range("A" & LastRow - 1) = Refdata.Range("A" & "r").Value outputWb.Sheets(1).Range("A" & LastRow) = Refdata.Range("A" & "r").Value outputWb.Sheets(1).Range("B" & LastRow - 3) = Refdata.Range("B" & "r").Value outputWb.Sheets(1).Range("B" & LastRow - 2) = Refdata.Range("B" & "r").Value outputWb.Sheets(1).Range("B" & LastRow - 1) = Refdata.Range("B" & "r").Value outputWb.Sheets(1).Range("B" & LastRow) = Refdata.Range("B" & "r").Value End If Next AddList Next r End Sub
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2021/12/29 03:44
2021/12/29 05:05