[[20200801113702]] 『VBAとVLOOKUP関数による値の挿入について』(エクセル勉強中) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『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.