[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBAとVLOOKUP関数による値の挿入について』(エクセル勉強中)
シート1の特定の列の番号(以下仮に「職員番号」とします。)が変更された場合に、
シート1の職員番号の右側の情報をシート2の職員の氏名や住所の値を貼り付ける
といったマクロを作りたいと考えています。
ネットの情報を見ながら以下のとおり、作ってみたのですが、うまくいきません。
アドバイスをいただけると助かります。
========================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A2:A5")) Is Nothing Then Exit Sub Else
Dim Serchkey As Range Dim Serchrange As Range Dim Outputrange As Range
Set Serchkey = Target.Value Set Serchrange = Worksheets("sheet1").Range("A2:B5") Set Outputrange = Cells(Target.Row, 2)
Outputrange = WorksheetFunction.VLookup(Serchkey.Serchrange, 2, False)
End If End Sub
< 使用 Excel:Excel2019、使用 OS:Windows10 >
SerchkeyをRange型で宣言しているのに、 Target.Valueを代入しようとしているからでは?
Variant型で宣言したらどうですか。 外していたらごめんなさい。
(tora) 2020/08/01(土) 12:53
普通に計算式を埋め込んでおけばよいと思いますが、 あえてVBAの勉強ということですか?
セルの値をユーザーが変更するのに伴ってなんらかの処理を行うなら、 Private Sub Worksheet_Change(ByVal Target As Range) です。今のは、セルの選択状況が変わったら、というイベントプロシージャです。
指摘がありました点は、 Dim Serchkey As Stringとして、Serchkey = Target.Valueでよいのではないですか。
>シート1の職員番号の右側の情報をシート2の職員の氏名や住所の値を貼り付ける 日本語がバグっていて、内容が正確につかめませんが、このあたりも確認して下さい。
また、Changeイベントプロシージャのなかでセルを変更すると、 それがまたイベントプロシージャを起動させますから、それを抑止することも必要です。 Application.EnableEvents = False 'セルの変更処理 Application.EnableEvents = True などとします。
なお、 Outputrange = WorksheetFunction.VLookup(Serchkey.Serchrange, 2, False) と、カンマのはずがドット(ピリオド)になっています。 投稿に際しては、手打ちせずに、コピーペイストされることをお薦めします。
そのほか、複数セルを同時に変更(貼付等で)する場合の対応とか、 消去に伴うエラーへの対応とかの論点もありますが、それはまた。 イベントプロシージャは結構気を使うことが多いですよ。
(γ) 2020/08/01(土) 13:25
最終的に以下の文章にて、おかげさまでやりたいことが実現しました。
なお、マクロを使わずにする方法についてはもちろん問題なくできるのですが、
運用上 年度毎に同様のファイルが作成されていくため、
できるだけ、リンクや参照先に影響を受けずに、運用できる仕組み
あと参照しようとするデータが膨大な容量なため、
マクロを使うことでが運用のしやすさにつながらないかと思い試行錯誤していたものです。
======================================
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A2:A5")) Is Nothing Then Exit Sub Else If WorksheetFunction.CountIf(Worksheets("sheet1").Range("A:A"), Target.Value) > 0 Then
Dim Serchkey As Variant Dim Serchrange As Range Dim Outputrange As Range
Set Serchkey = Target Set Serchrange = Worksheets("sheet1").Range("A2:B5") Set Outputrange = Cells(Target.Row, 2)
Application.EnableEvents = False
Outputrange = WorksheetFunction.VLookup(Serchkey, Serchrange, 2, False)
Application.EnableEvents = True
Else
MsgBox "職員番号が存在しません。" End If End If End Sub
(エクセル勉強中) 2020/08/01(土) 16:12
■1
γさんが指摘されているとおり、ChangeイベントのTargetは複数セルになることがあり得ます。
仮に、複数セルだった場合↓の部分で実行時エラーが発生すると思います。
If WorksheetFunction.CountIf(Worksheets("sheet1").Range("A:A"), Target.Value) > 0 Then Set Outputrange = Cells(Target.Row, 2) Outputrange = WorksheetFunction.VLookup(Serchkey, Serchrange, 2, False)
■2
同じく指摘されているように、セルの値の変化は、値をクリアしても発生します。
今回のケースでは↓のおかげで実行時エラーにはなりませんが、一般的には「""」だったときの処理を決めておくとよいとおもいます。
If WorksheetFunction.CountIf(Worksheets("sheet1").Range("A:A"), Target.Value) > 0 Then
■3
誤解されるとまずいですが、"今回の場合は"EnableEventsによってイベントを停止しなくても大丈夫です。(しては駄目だという意味ではありません)
↓の部分でA列の変更でなければ、即終了にしていて
If Intersect(Target, Range("A2:A5")) Is Nothing Then Exit Sub
↓でB列に出力するようにしているため、無限連鎖にはなりません。
Set Outputrange = Cells(Target.Row, 2)
■4
上記を踏まえると、こんな感じでもよかったと思います。
Private Sub Worksheet_Change(ByVal Target As Range) Dim tmpRNG As Range Dim MyRNG As Range Dim buf As Variant
Stop 'ブレークポイントの代わり
Set tmpRNG = Intersect(Target, Range("A2:A5")) If Not tmpRNG Is Nothing Then For Each MyRNG In tmpRNG If MyRNG.Value = "" Then MyRNG.Offset(0, 1).ClearContents Else buf = Application.VLookup(MyRNG.Value, Worksheets("Sheet1").Range("A2:B5"), 2, False) If IsError(buf) Then MsgBox "職員番号が存在しません。" Else MyRNG.Offset(0, 1).Value = buf End If End If Next MyRNG End If End Sub
■5
余談になりますが、マクロを使った場合、その時点で"元に戻す"のために記録されていた情報がクリアされてしまうため、そのシートでは実質的に「元に戻す」がほぼ使えなくなります。
ご自身が使われるのであれば、わかってるから良いでしょうが別の方が使われるのであれば戸惑いの声が出るかもしれません。
そうしたことも加味して、Changeイベントを使用されるか決めるとよいとおもいます。
(もこな2 ) 2020/08/02(日) 10:41
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.