Q&A
どんなエラーが出るかを書くと良いと思います。
前提・実現したいこと
作業員名簿を簡単に作成したいと思い取り組んでいます。
作業員名簿のデータベースとテンプレートの2つのExcelファイルがあります。
テンプレートのファイルで会社名を選択することによって
作業員名簿のデータベースから該当の作業員名を
テンプレートのシート(リスト）に転記したいのです。
VBA初心者でいろいろ調べながら進めましたが
止まってしまいます。
どなたか教えていただけないでしょうか。
よろしくお願いいたします。
■■の部分でエラーが出て止まってしまいます。
Private Sub Worksheet_Change(ByVal Target As Range)
'会社名変更時に作業員名を取り込む
'wbdb データベース
'wbte 取り込むテンプレート
Dim SetFile As String Dim wbte, wbdb As Workbook Set wbte = ActiveWorkbook 'マスターデータ取り込み元をブック名をセット（取り込み元：テンプレート） Application.DisplayAlerts = False 'マクロの実行中に特定の警告やメッセージを表示しない SetFile = "E:\会社データベース.xlsm" 'マスターデータファイルの取り込み場所をセット（データベースのアドレス） Workbooks.Open Filename:=SetFile, ReadOnly:=True, UpdateLinks:=0 'マスターデータファイルを読み取り専用で開きます（） Set wbdb = Workbooks.Open(SetFile) '開いたマスターブック名とセット（取り込み先）
Dim i As Long, i_max As Long
Dim m As Long
m = 2
wbte.Worksheets("リスト").Range("C2:E51").ClearContents
i_max = wbdb.Worksheets("作業員名簿").Cells(Rows.Count, 2).End(xlUp).Row
For i = 4 To i_max
■■ If wbdb.Worksheets("作業員名簿").Cells(i, 2) = wbte.Worksheets("作業員名簿_全建統一5号").Cells(1, 50) Then
wbte.Worksheets("リスト").Cells(m, 3).Value = wbdb.Worksheets("作業員名簿").Cells(i, 2).Offset(0, 1).Value wbte.Worksheets("リスト").Cells(m, 4).Value = wbdb.Worksheets("作業員名簿").Cells(i, 2).Offset(0, 2).Value wbte.Worksheets("リスト").Cells(m, 5).Value = wbdb.Worksheets("作業員名簿").Cells(i, 2).Offset(0, 3).Value m = m + 1 End If
Next
Application.CutCopyMode = False
wbdb.Close False Application.DisplayAlerts = True
End Sub
言葉足らずで申し訳ありません。
黄色に反転し止まってしまいます。
エラーメッセージが出てくるというわけではなく停止してしまいます。
F5を押したら再開したりしますか？
再開せずに
「実行時エラー’-2147221080（800401a8）':
オートメーションエラーです。」
とメッセージが出てきました。
■■の前に
debug.print wbdb.Worksheets("作業員名簿").Cells(i, 2)
debug.print wbte.Worksheets("作業員名簿_全建統一5号").Cells(1, 50)
を入れて■■まで正常に動きますか？
debug.print wbdb.Worksheets("作業員名簿").Cells(i, 2)
が黄色反転し止まりました。
F5で先ほどと同じエラーメッセージが表示されました。
さらに、この前にこちらを追加して下さい。
debug.print i
debug.print wbdb.name
debug.print wbdb.Worksheets("作業員名簿").name
※.どれかの値が正しくないですので、個々の値をイミディエイト画面で確かめます。イミディエイト画面は表示されていますよね。
p.s.
Workbooks.Open Filename:=SetFile,ReadOnly:=True,UpdateLinks:=0
Set wbdb = Workbooks.Open(SetFile)
で2回開いていますが、
Set wbdb = Workbooks.Open(Filename:=SetFile,ReadOnly:=True,UpdateLinks:=0 )
この様な感じが正解ではないでしょうか？
２回開く形になっているので２回目に警告が出るのをApplication.DisplayAlerts = Falseで握りつぶしているということなのかな。tosiさんの書いているようにすれば改善すると思います。
イミディエイト ですがよくわからず、
下部で最小化しておりました。
今初めて表示されている内容を確認しました。
debug.print wbdb.name が黄色反転で止まりました。
４
会社データベース.xlsm
作業員名簿
〇〇会社
5
で止まっています。
一行づつ結果を補表示しているということなのでしょうか。
5行目に行けない理由が私にはわからず涙 何が起こっているのでしょう。
イミディエイト画面はメニューの表示から、イミディエイトウィンドウを選択すると、画面のどこかに出てくる筈です。debug.printで指定された値が行へ表示されます。
wbdb.nameでエラーですから、 Workbooks.Openで読み込まれたExcelが正しく、wbdbへセットされていません。先ほど書いた方法へ書き換えて見て如何でしょうか。
書き換えてみましたが、結果は同じでした。涙
以下の行をコメントにして、Workbooks.Openでエラーを表示させて下さい。
'Application.DisplayAlerts = False
何れにしても、open後にwbdbへ正常にExcelがセットされていません。
Excelファイル+Path名称が違うのか、SetFileの値をdebug.Printで確認します。
この関数って、どのシートのモジュールに書かれていますか？
テンプレート側
wbteの作業員名簿_全建統一5号
に書いています。
イベントモジュール詳しく分かりませんが Private Sub Worksheet_Change このイベントは
確か セルの値が変更されたときなど、マクロ実行されるイベントだとおもいます
マクロ実行されるセル範囲が指定されていいません、全てのセルが対象になってしまいます。
一度、標準モジュールにコピーして ”Application.DisplayAlerts = False” この部分
をコメント化して実行してみては？
モニター画面を半分シート画面もう半分をモジュール画面にしてモジュール画面を一度クリックしてから
「Ｆ８」キーを押して黄色いカーソルの動きを確認してみては・・・
回答1件
0
ベストアンサー
VBA
1Private Sub Worksheet_Change(ByVal Target As Range) '作業員名簿_全建統一5号 2 If Target.Address <> "$AX$1" Then Exit Sub 3 Dim ws As Worksheet 4 Set ws = Workbooks.Open("E:\会社データベース.xlsm").Worksheets("作業員名簿") 5 Dim rng As Range 6 Set rng = ThisWorkbook.Worksheets("リスト").Range("C2:E2") 7 rng.Resize(50).ClearContents 8 Dim i 9 With ws 10 For i = 4 To .Cells(.Rows.Count, 2).End(xlUp).Row 11 If .Cells(i, 2).Value = Target.Value Then 12 rng.Value = .Cells(i, 3).Resize(, 3).Value 13 Set rng = rng.Offset(1) 14 End If 15 Next 16 .Parent.Close False 17 End With 18End Sub
投稿2021/07/02 10:34
総合スコア4592
皆様ありがとうございました。
jinoji様のコードのtargetの部分を少し改造してできるようになりました。
F5の再開も
debug.printもF8で一行づつ進めていくことも
私には初めてのことで大変勉強になりました。
心から感謝いたします。
ありがとうございました。
完成まではまだ先がありますが頑張ってみます。
今後ともよろしくお願いいたします。
あなたの回答
tips
プレビュー
