エクセル2003のVBA

質問

お尋ねします。

契約書管理台帳をエクセル2003で作成中です。
シート1には、日付、契約書名、顧客コード、顧客名等
シート2には、顧客コード、顧客名等、顧客名カナ等、顧客情報がリストになっています。

契約書が来たときに、顧客コードをシート2より、ひっぱりたいのです。
リストを考えたのですが、500件ほどあり、とても選べません。
なので、イメージとして
カナ検索、例えばフォームに、グーといれれば、グー株式会社を検索し、
0001というコードをセルに表す、という感じです。

VBAを使わなくて良ければ、それが一番いいのですが、色々検索すると、
使わないとできなさそうなので。。。。

どなたか、ご教授ください。よろしくお願いします。

回答No.2

TAKA_R

１です。
少し使いやすくしてみました。
シート1のイベントウィンドウ？に貼り付けてください。
これでボタンいらずです。
コードを書き込むセルをダブルクリックしたら使えます。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim getstr As String
Dim rg As Range
Dim r As Integer
Dim ws2 As Worksheet
Set ws2 = Worksheets("sheet2")

If IMEStatus <> vbIMEModeKatakana Then
SendKeys "{kana}"
End If
If Target.Column = 5 Then '5はシート1のコードを入れたい列を入れる
getstr = InputBox("カタカナで顧客名を入れてください。", "顧客コード検索")

If getstr = "" Then Exit Sub

Set rg = ws2.Cells.Find(getstr)

If rg Is Nothing Then
MsgBox (getstr + "は見つかりませんでした。")
Exit Sub
End If
r = rg.Row
Target = ws2.Range("c" & r) 'cはシート2の顧客コードの書かれた列を入れる
End If
End Sub

関数を使う場合、どうしても検索する文字を記入する場所が必要になって、そこのところがネックです。
match関数でそれ以外は解決するんですけれど・・・。

回答No.1

TAKA_R

多分、関数で探せます。
ただし、１列増やさないと作れないし、検索文字を昇順に並び替える必要もありそうです・・・。
というわけで、ＶＢＡを組んでみました。
ちなみにフォームではなくインプットボックスを使っています。（楽だし）
動作させるスイッチとして、シート１にボタンか絵を挿入してマクロの登録をしてくださいな。
（スイッチはウィンドウ枠を固定したところにつけたら便利かと思います）
気をつける点は、
・選択したセルに検索したコードを書き込みます。
・ワイルドカード（*とか？とか＆とか）は使えません。連続した文字を検索する欄に書き込んでください。
・書き換え（半角カナを全角カナに戻したり）という作業は入れていません。そのまんまの文字を検索してきます。
・数箇所「’」で書いているコメント内容は書き換えないと使えません。コメントの内容に沿って書き直してください。
あと、一気に書き込むことを目的とした表ではなくって、一行ずつ入力していく表だと理解したので、このようなコードになっています。

Sub 検索()
Dim getstr, code As String
Dim rg, rg1 As Range

getstr = InputBox("カタカナで顧客名を入れてください。", "顧客コード検索")

If getstr = "" Then Exit Sub
Set rg1 = ActiveCell
Worksheets("sheet2").Activate
Set rg = Worksheets("sheet2").Cells.Find(getstr) 　　　　　 'Worksheets("sheet2").Cellsをrange("a1:a5")みたいに狭くすると間違いがなくなったり、速くなったりする

If rg Is Nothing Then
MsgBox (getstr + "は見つかりませんでした。")
Exit Sub
Else
rg.Offset(0, k).Select 'ここのｋはカナフリガナから見てコードのある位置。右に向かって数える。（左はマイナス）
code = ActiveCell.Value
End If

Worksheets("sheet1").Activate
rg1 = code
End Sub