質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.46%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

コードレビュー

コードレビューは、ソフトウェア開発の一工程で、 ソースコードの検査を行い、開発工程で見過ごされた誤りを検出する事で、 ソフトウェア品質を高めるためのものです。

Q&A

1回答

606閲覧

二つの別々のブックを参照して、第3の新しいブックにリストを作成したいです。

harryban

総合スコア4

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

コードレビュー

コードレビューは、ソフトウェア開発の一工程で、 ソースコードの検査を行い、開発工程で見過ごされた誤りを検出する事で、 ソフトウェア品質を高めるためのものです。

0グッド

1クリップ

投稿2021/12/28 20:00

前提・実現したいこと

二つの別々のブックを参照して、第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

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答1

0

下記の修正をしてみてください。

diff

1 ‘—inputWbのA2からA最終行と、RefdataブックのA2からA245までの項目をそれぞれ参照 2- For Each AddList In inputSh.Range("A2:" & LastRow)  3+ For Each AddList In inputSh.Range("A2:A" & LastRow) 

あと、RefdataSh.Range("A" & "r").Valueでもエラーが出そうですね。
RefdataSh.Range("A" & r).Valueと修正してみてください。

投稿2021/12/29 01:52

編集2021/12/29 01:58
hatena19

総合スコア33795

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

harryban

2021/12/29 03:44

早速のアドバイス有難う御座います。試したところ、ご指摘箇所の問題点は解消したのですが、outputWb.Sheets(1).Range("A"&LastRow-3)=Refdata.Range("A"&r).Valueでエラー438「オブジェクトは、このプロパティまたはメソッドをサポートしていません。」が出てしまいました。Range("A"&LastRow-3).Valueに訂正してみたのですが、同じエラーが出ます。もしお気づきの点が御座いましたらご教授いただけますでしょうか。
hatena19

2021/12/29 05:05

Refdata はワークブックなのでRnageプロパティはないですね。 ここは、ワークシートに指定しないと。 RefdataSh.Range("A" & r).Value
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

まだベストアンサーが選ばれていません

会員登録して回答してみよう

アカウントをお持ちの方は

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.46%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問