現在は相互に関連付けられていないのでデータを有効的に活用できていません。これをマクロによって作業の簡略化、データの有効活用を行いたいと考えています。
まず顧客が購入すると会員番号を「来店記録」書き留めます。この会員番号を「顧客名簿」で検索し、該当する顧客の旧会員番号、会員資格、名前、フリガナを「来店記録」に転記するマクロを作りたいと思います。
データを記録するのはエクセルの知識がほとんどない販売スタッフです。データベースソフトを使えればよいのですが以前導入に失敗しました。現行作業をあまり変えることなく行うのが今回の方針です。
マクロの知識が浅いため、解決方法そのものを教えていただければうれしいです。もしそのまま使える完全なコードややり方を回答していただいた回答者の方には500ポイントを差し上げます。よろしくお願いいたします。
※文字制限のため「来店記録」、「顧客名簿」のサンプルデータ、仕様の詳細はこの下にある「この質問・回答へのコメント」に記載いたします。
No.1
3454
969
500pt
コメントでも少し書きましたが、検索方法で顧客名簿の項目を検索しているので
顧客名簿の列はＡ列から始まっていない場合を考慮して仕様に忠実にマクロを作ってみました。
ただし、来店記録はＡ列から始まっているとします。
Sub MacroSerch() If Selection.Value = "" Then Exit Sub Dim kensaku_keyword As String Dim kensaku_retsu As String Dim c As Integer Dim obj As Range Dim i As Integer With Worksheets("来店記録") kensaku_keyword = moji(Selection.Value) kensaku_retsu = .Cells(1, Selection.Column).Value Set obj = Worksheets("顧客名簿").Columns(retu(kensaku_retsu)).Find(kensaku_keyword _ , , xlValues, xlWhole, xlByColumns, xlNext, True, True) If obj Is Nothing Then MsgBox "該当する顧客が見つかりません。名前、フリガナ等で検索してみてください" Else For i = 2 To 6 .Cells(Selection.Row, i).Value = Worksheets("顧客名簿").Cells(obj.Row, _ retu(.Cells(1, i).Value)).Value Next i .Cells(Selection.Row, 7).Value = Date End If End With End Sub '文字列に＊を入れる Function moji(st As String) As String Dim i As Integer Dim str As String str = "*" For i = 1 To Len(st) str = str & Trim(Mid(st, i, 1)) & "*" Next i moji = str End Function '項目が顧客名簿のどの列かを返す Function retu(st As String) As Integer Dim c As Integer c = 1 While Worksheets("顧客名簿").Cells(1, c).Value <> st c = c + 1 Wend retu = c End Function
icta
2008/05/15 16:29:31
46
45
t_shiono
SALINGER
2
1
1
>SALINGERさん
いつもありがとうございます。
教えていただいたコードで希望通りの動作を確認しました。
本当にありがとうございます。
新しい質問をhttp://q.hatena.ne.jp/1210860623へ投稿しました。
またご協力いただければ大変うれしいです。