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

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

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

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

Q&A

解決済

1回答

739閲覧

VBAでダイアログボックスから開いたExcelファイルと別のファイルのA列を比較して、同じならB列C列の値をコピペしたいです。

dradradra2203

総合スコア1

VBA

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

0グッド

0クリップ

投稿2023/01/31 02:48

前提・実現したいこと
VBA を使い、2つのブックを比較してデータの転機をしたいです。
その際、比較する先のファイルをダイアログボックスから開くようにしています。

データの比較について説明すると、まずA列の数字を2つのブック間で比較をします。
その後、同じだった場合、比較する先のファイル(fn1)のB列、C列の値をもとのブック(Wb1)に張り付けるというものです。
例)If Wb1.Cells(1,1).Value=fn1.Cells(1,5) Then
Wb1.Cells(2,1)=fn1.Cells(2,5)
Wb1.Cells(3,1)=fn1.Cells(3,5)   というような感じ
これをsheet1,2・・・およびA列で繰り返していきたいです。

発生している問題・エラーメッセージ

ダイアログボックスからExcelファイルを開くところまでは動くのですが、If文の部分から先で止まってしまいます。
主にオブジェクトについてのエラーコードが出てしまう状況です。

エラーメッセージ

該当のソースコード

Sub sisaku1() ' ' sisaku1 Macro ' ' Dim wb1 Set wb1 = ThisWorkbook//マクロを動かしているブック、貼り付け先 Dim fn As String fn = Application.GetOpenFilename(FileFilter:="Excelファイル,*.xlsx") If fn <> "False" Then Workbooks.Open fn fn1 = Dir(fn) //比較する先 MsgBox fn1 //開いたファイル名を表示 For Each objSheet In ThisWorkbook.Worksheets //貼り付け先のすべてのシートを参照 Dim j As Integer //比較する先のファイルの行 Dim i As Integer //貼り付け先のファイルの行 For i = 1 To 1000 For j = 1 To 1000 If Wb1.Worksheets.Cells(j, 1).Value = Workbooks(fn1).Worksheets("Sheet1").Cells(i, 1).Value Then //それぞれのブックのセルの値を比較していく Wb1.Worksheets.Cells(j, 2).Value = Workbooks(fn1).Worksheets("Sheet1").Cells(i, 2).Value Wb1.Worksheets.Cells(j, 3).Value = Workbooks(fn1).Worksheets("Sheet1").Cells(i, 3).Value End If Next j Next i Next Else MsgBox "エラーです"   //ファイルを選ばなかったときのエラー文 End If End Sub

試したこと

補足情報(FW/ツールのバージョンなど)

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

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

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

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

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

pig_vba

2023/01/31 02:54

エラーメッセージが出ているならその内容、エラー発生時にデバッグ押すと黄色で反転表示される行を明記するとより迅速な回答が得られやすくなります。
pig_vba

2023/01/31 02:56

真っ先に目につくのは If Wb1.Worksheets.Cells(j, 1).Value = Workbooks(fn1).Worksheets("Sheet1").Cells(i, 1).Value Then //それぞれのブックのセルの値を比較していく ここ、一行を分割する時に必要な_がないので構文エラーが発生しているのではないでしょうか
guest

回答1

0

ベストアンサー

Workbook.Worksheetsプロパティの使い方が全体的におかしいです。変数宣言の位置なども見直した方がいいでしょう。

VBA

1Option Explicit 2Sub sisaku1() 3' 4' sisaku1 Macro 5 6' 7' 8 Dim ws1 as worksheet 'thisworkbook内のシート操作用 9 10 Dim wbF As Workbook 11 Dim wsF As Worksheet 12 Dim j As Integer '比較する先のファイルの行 13 Dim i As Integer '貼り付け先のファイルの行 14 15 Dim fn As String 16 fn = Application.GetOpenFilename(FileFilter:="Excelファイル,*.xlsx") 17 18 19 If fn = "False" Then 20 MsgBox "ファイルが選択されませんでした" 21 Exit Sub 22 End If 23 24 With Application 25 .ScreenUpdating = False 26 .EnableEvents = False 27 28 End With 29 Set wbF = Workbooks.Open(fn) 30 MsgBox fn '開いたファイル名を表示 31 Set wsF = wbF.Sheets("Sheet1") 32 33 34 For Each ws1 In ThisWorkbook.Worksheets '貼り付け先のすべてのシートを参照 35 36 37 For i = 1 To 1000 38 For j = 1 To 1000 39 If ws1.Cells(j, 1).Value = wsF.Cells(i, 1).Value Then 'それぞれのブックのセルの値を比較していく 40 41 ws1.Cells(j, 2).Value = wsF.Cells(i, 2).Value 42 ws1.Cells(j, 3).Value = wsF.Cells(i, 3).Value 43 Exit For '同じ項目はないだろうからさっさと飛ばす 44 45 End If 46 Next j 47 Next i 48 Next 49 50 With Application 51 .ScreenUpdating = True 52 .EnableEvents = True 53 End With 54 55End Sub 56

投稿2023/01/31 03:13

編集2023/01/31 03:15
pig_vba

総合スコア807

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

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

pig_vba

2023/01/31 03:16

本筋ではないですが、ついでに言うとVBAのコメントは//ではなく'です。
dradradra2203

2023/01/31 03:23

ありがとうございます。 無事動きました。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

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

ただいまの回答率
85.48%

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

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

質問する

関連した質問