またまた便利マクロを思いついたのでメモ。ていうか職場でもう実用してます。
擬似的なデータベースファイルとして動作させる
例えばSheet1に請求明細を入力するときに、Sheet2の口座や住所などを記載した利用者名簿からIDを引っ張って来たい場合。新しいウィンドウを開いて「並べて表示」してもいいが、スクロールしたりするときに各々切り替えて操作するのが微妙に面倒。シート切り替えもいちいちマウス持ちたくないのにキーボードだけだと[Ctrl]+[PageDown/Up]でこれも操作が微妙。紙に印刷しておくとかはもう論外です。
なので、Sheet1のID列のセルをダブルクリックしたときに、Sheet2の名簿に検索をかけることにします。このとき、検索キーは氏名にします。テーブルの構成は画像の感じです。
※Sheet1は「請求先マスタ」という名前になっています。またSheet2にはIDを入力したときにVLOOKUPで氏名とﾌﾘｶﾞﾅを取得する数式を仕込んでいます。ありがちなやつです。
実コード
ここで仕込むマクロが以下。Sheet2のモジュールに記述するだけです。
Function Search_ID() As String
Dim buf As String
Dim Trg As Worksheet
Dim Reg As Range
If IMEStatus = vbIMEModeOff Then SendKeys "{kanji}"
buf = InputBox("氏名を入力してください", "利用者氏名検索", "")
If buf = "" Then Exit Function
Set Trg = Sheets("請求先マスタ")
Set Reg = Tgr.Range("B:B").Find(what:=buf)
If Reg Is Nothing Then
MsgBox "該当なし"
Else: Search_ID = Reg.Offset(0, -1).Value
End If
If IMEStatus = vbIMEModeOn Then SendKeys "{kanji}"
End Function
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A2:A1048576")) Is Nothing Then
Dim num As String
num = Search_ID
Target.Value = num
SendKeys "{ESC}"
End If
End Sub本当はWorkbook.OpenイベントにApplication.Onkeyで[F8]キーかなんかに割り当てるマクロを呼び出させて動作させようと思っていたんですが、職場のセキュリティ設定の関係か動作せず、こんなコードを書きました。
マクロ無効セキュリティの突破
勿論、そうなるとマクロ付きブックであってもただ開いただけではマクロ無効になってしまうので、これを動作させるためにはVBS等からの呼び出しが必要です。念のため、以下記述します。
Dim xlApp
Dim xlWbk
Set xlApp = CreateObject("Excle.Application")
xlApp.Visible = True
Set xlWbk = xlApp.Workbooks.Open("\Hoge\HogeHoge\Hoge001.xlsm", True)
Exit
これをメモ帳などで記述し、拡張子「.vbs」で保存します（なおフォルダおよびファイル名(HogeとかHogeHogeとか)はダミーですので、環境に合わせてフルパスを書いてください）。そのままスクリプトファイルをダブルクリックでもいいし、心配ならショートカットを作成します。これならスクリプトファイルやマクロ付きブックファイルはどこかに隠しておくことが可能なので、削除されてしまうことはありません。
注意事項
ちなみに、これはOfficeの仕様ですが、VBSを使ってマクロ有効でブックを開くと独立のExcelインスタンスとなるため、そのプロセス以外ではマクロ無効となります。その辺は安心なんですが、マクロ有効のインスタンスに他所のマクロを呼び込んだりしないように注意が必要です。
おわりに
このマクロのいいところは、最悪マクロ無効のままでもブックの機能自体は保たれるところです。コードでは別シートの数値(文字列型だけど)を取得してセルに書き込む、つまり手入力を代行しているだけですので。実作業でも同じIDの明細を連続して入力する場合、上のセルの値を手入力すればいいのでこの機能は使わないでしょう。
ちょっとして手間の軽減に応用できればよいと思います。
