解決済み

EXCELで顧客管理

  • 困ってます
  • 質問No.296809
  • 閲覧数544
  • ありがとう数3
  • 気になる数0
  • 回答数3
  • コメント数0

お礼率 100% (8/8)

EXCELで顧客管理をしたいと思います。
一行に・・・
 名前、フリガナ、郵便番号、住所、生年月日・・・・・・
と一つずつのセルに入力してあります。
500名分を7シートに分けて打ち込んであります。

(1)「フリガナ」の2文字を入力すると適合する顧客が別シートに一覧として表示されるようにしたい。
(2)「フリガナ」を入力して・・・という作業をする入力フォームを作りたい。
(フリガナを入力する→検索ボタンをクリック→表に一覧が表示されるといった形式のもの)

以上、2点について教えていただければ幸いです。
これは可能なことなのかもよくわかりませんがよろしくお願いします。

 
通報する
  • 回答数3
  • 気になる
    質問をブックマークします。
    マイページでまとめて確認できます。

質問者が選んだベストアンサー

  • 回答No.1

ベストアンサー率 58% (513/875)

次の参考マクロは、顧客リストのシートを "Sheet1"、抽出用シート名を "Sheet9" とした場合です。
不得意分野ですので、スマートではありませんが、参考にしてください。
まず、住所録データの入ったブックを呼び出して、VB Editor の標準モジュールに下記のコマンドをコピペしてください。
ここでは、Sheet1は、A列から「名前」「よみ」「郵便番号」「住所」の順に並んでいて、見出し行なしでデータは1行目から入っていると仮定していますので、実験用として、データをそのように加工してください。
また、Sheet9 を作成してください。
'---- コピーは次行から -------
Sub LstMk()
OPL = 0
Application.ScreenUpdating = False
Yomi = InputBox("名前の読み二文字を入力して下さい")
' ※
Worksheets("Sheet1").Select
LL = ActiveSheet.Range("A1").CurrentRegion.Rows.Count
For DTL = 1 To LL
Worksheets("Sheet1").Select
Cells(DTL, 2).Select
DT8 = ActiveCell
If Left(DT8, 2) = Yomi Then
OPL = OPL + 1
Cells(DTL, 1).Select
名前 = ActiveCell
Cells(DTL, 3).Select
郵便 = ActiveCell
Cells(DTL, 4).Select
住所 = ActiveCell
Worksheets("Sheet9").Select
Cells(OPL, 1).Select
ActiveCell.FormulaR1C1 = 名前
Cells(OPL, 2).Select
ActiveCell.FormulaR1C1 = DT8
Cells(OPL, 3).Select
ActiveCell.FormulaR1C1 = 郵便
Cells(OPL, 4).Select
ActiveCell.FormulaR1C1 = 住所
End If
Next DTL
' ※
' #
Worksheets("Sheet1").Select
Application.ScreenUpdating = True
End Sub
'---- コピーは前行まで -------
コピー後 VB Editor を閉じ、[ツール]-[マクロ]-[マクロ] から、LstMk を実行し、処理終了後に Sheet2 を開いてみてください。
++++++++++++++++
データシートは1枚を仮定しています。お手持ちのようにデータが複数シート(同様式)の場合は、上コマンドの "※"~"※" を シート名を変えて繰り返せばよいでしょう。
お礼コメント
fs-30

お礼率 100% (8/8)

ありがとうございます!!只今作業途中ですが御礼だけ先にいたしますね。
コピーができましたので加工中です。
自分で必死に調べてもどうつなぎ合わせてどうやれば・・・と頭が混乱していました。一つの理屈にまとめて教えていただいたので脳みそがスッキリしました。
初心者の私には神様の様です!!
がんばって作ります。
投稿日時 - 2002-06-21 17:14:03
OKWAVE 20th Be MORE ありがとうをカタチに

その他の回答 (全2件)

  • 回答No.3

ベストアンサー率 28% (4424/15722)

オフィス系ソフト カテゴリマスター
既に出ているご回答が長いので、短くならないかやって見ました。
25行程度になりました。ただ下記は至らぬ点があります。
(1)Sheet1からSheet7までの範囲を続けて検索する技術が
  判らず、対応が出来ていない。致命的か?ご存知の方は
  教えて頂ければと思います。Sheets(Array(”Sheet1","Sheet2"))  ・・・・が上手く行かなかった。
(2)カナ名索引の例でない。これは下記を少し変えて、直すことがで  きる。漢字名検索の方を勧めますが。
 なお漢字名の一部でも検索してくることは確認済。(「大木 武」
  で検索すると「大木 武雄」だけ出る。)
(3)結果をフォームに表示していない。検索氏名をフォームで
  聞いていない。これに対しては使っていないシートをフォームのよ  うに使うとかで切りぬけられる(VBと違いユーザーフォームがエク  セルVBAでは許されていない(?)ようなので)。売り物でなけれ  ばInputboxで我慢できるのでは。
-----
テストデータとしてA1:C13に下記のデータを入力。
氏名録
黒石 明      北区24歳
山田 治夫大阪市35歳
金田 俊夫大阪市23歳
上野 義男金沢市20歳
大田 信夫新潟市22歳
安田 寛       丹後市56歳
澤田 建次岡山市33歳
大木 茂       笠岡市26歳
大木 武雄下関市43歳
山田 謙       北上市22歳
栗本 裕二甲府市56歳
VBEのModule1に
Sub Testo1()
Sheets("sheet1").Select
Range("e2:g13").ClearContents
l = Range("a2").CurrentRegion.Rows.Count
i = 2
x = InputBox("名前=")
Set c = Range(Cells(2, 1), Cells(l, 1)).Find(What:=x, LookIn:=xlValues, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False)
If Not c Is Nothing Then
fadr = c.Address
Do
Worksheets("sheet1").Cells(i, 5) = c.Offset(0, 0) 'a
Worksheets("sheet1").Cells(i, 6) = c.Offset(0, 1) 'b
Worksheets("sheet1").Cells(i, 7) = c.Offset(0, 2) 'c
i = i + 1
Set c = Range(Cells(2, 1), Cells(l, 1)).FindNext(c)
If c.Address = fadr Then Exit Do
Loop
End If
End Sub
実行して「氏名=」と聞いてくるので、「大木」と入力。
E2:G4に
大木 茂       笠岡市26歳
大木 武雄下関市43歳
大木 広       長野市33歳
と検索結果が出ます。(以上テスト済。エクセル2000で。)
お礼コメント
fs-30

お礼率 100% (8/8)

出掛けておりまして御礼が遅くなってすみません。
ありがとうございました。
このくらいの長さだと、コピー貼り付けではなく自分で一つ一つ入力できるのでとても勉強になりました。かなり満足のいくものができました。感謝!!!です。
投稿日時 - 2002-06-24 10:32:53
  • 回答No.2

ベストアンサー率 68% (791/1163)

シートでの処理-1
1.データは500名くらいで、シートは複数枚あるとします。(同じ形式なら何枚でもいいですが)
2.各シートは同一形式で1行目は表題、2行目からデータが入っているとします。
3.一覧表示させるシートを挿入してシート名『抽出』を付けます。

VBE画面での処理(ユーザーフォームを作ります)
1.ツール→マクロ→Visual Basic Editor でVBE画面に移り、挿入→ユーザーフォーム(UserForm1)
2.表示→ツールボックスでツールボックスを出して、このユーザーフォームに
   テキストボックス(TextBox1)とコマンドボタン(CommandButton1)を作ります。
    TextBox1を右クリックして、プロパティを選択
     IMEMode を 5 - fmIMEModekatakana に
    CommandButton1を右クリックして、プロパティを選択
     Caption を『抽出』に
     Default を True にする。
3.CommandButton1をダブルクリックすると、ユーザーフォームのコードウインドウに
   Private Sub CommandButton1_Click()

   End Sub
  ができるので、下のコード(※)をコピーして貼り付ける。
  
  startCol = "C" にデータ登録の開始列をセットします。今はC列からデータがある事にしています。
  Koumoku = 7  にデータの項目数をセットします。今は1行に7項目あるとしています。
  FuriCol = 2  にフリガナが左から何番目にあるかセットします。今はD列にあり2番目です。

シートでの処理-2
1.シート『抽出』に戻ります。
2.表示→ツールバー→Visual Basic で Visual Basicのツールバーを表示。
3.コントロールツールボックスをクリック
4.コントロールツールボックスのコマンドボタンをクリックして、シート上にボタンを1つ作成。
5.ボタンの見た目は右クリックしてプロパティを選択して設定します。
6.ボタンは小さくして、1行目の左辺りに置いていたほうがいいでしょう。
7.ボタンをダブルクリック。(またVBE画面になる)
8.シート『抽出』のコードウインドウが
  Private Sub CommandButton1_Click()

  End Sub
  なっているので、下のように書く。
  Private Sub CommandButton1_Click()
    UserForm1.Show
  End Sub
9.シート『抽出』に戻ります。
10.コントロールツールボックスを閉じる。
  デザインモードになっていたら解除する。

これでできているはず・・・・です。一応、別名で保存してボタンを押します。
何よりも説明が一番難しいですね。(当方Excel97です)

  『フリガナの2文字と適合』については、入力した文字がフリガナの中にあれば抽出しています。
  これを先頭からのみの照合に限定するなら下記のようにします。
    If InStr(.Cells(rw, fCol), inpFuri) >= 1 Then
     ↓
    If InStr(.Cells(rw, fCol), inpFuri) = 1 Then


(※)ユーザーフォームのコードウインドウに貼り付け
 ↓
Private Sub CommandButton1_Click()
  Const startCol = "C" 'データ登録の開始列
  Const Koumoku = 7 '項目数
  Const FuriCol = 2 'フリガナは左から何番目?

  Dim sCol As Integer '開始列
  Dim fCol As Integer 'フリガナがある列
    sCol = Range(startCol & "2").Column
    fCol = Range(startCol & "2").Column + FuriCol - 1
    Range(Cells(2, sCol), Cells(500, sCol + Koumoku - 1)).ClearContents

  Dim rw As Long, rwOut As Long '検索行と出力行
  Dim inpFuri As String '指定したフリガナ2文字(3文字でもいい)
  Dim ws As Worksheet 'データ入力されたシート
  Dim wsOut As Worksheet '抽出結果の出力シート
    Set wsOut = Worksheets("抽出")
    inpFuri = TextBox1.Text

  Application.ScreenUpdating = False
  ActiveCell.Activate
  rwOut = 1
  For Each ws In Worksheets
    If ws.Name <> "抽出" Then
      rw = 2
      With ws
        While .Cells(rw, fCol) <> "" 'セルを調べる
          If InStr(.Cells(rw, fCol), inpFuri) >= 1 Then
            rwOut = rwOut + 1
            .Range(.Cells(rw, sCol), .Cells(rw, sCol + Koumoku - 1)).Copy _
                              Destination:=wsOut.Cells(rwOut, sCol)
          End If

          rw = rw + 1
        Wend
      End With
    End If
  Next
  Application.ScreenUpdating = True

  Me.Hide
End Sub
お礼コメント
fs-30

お礼率 100% (8/8)

ありがとうございます!!
これまた親切な御指導で感激してます。
わかりやすいですね。
これから必死にやってみます。
とりあえず御礼だけさせていただきます。
感謝です。
投稿日時 - 2002-06-21 17:41:19
このQ&Aで解決しましたか?
AIエージェント「あい」

こんにちは。AIエージェントの「あい」です。
あなたの悩みに、OKWAVE 3,500万件のQ&Aを分析して最適な回答をご提案します。

関連するQ&A
このやり方知ってる!同じこと困ったことある。経験を教えて!
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。

その他の関連するQ&A、テーマをキーワードで探す

キーワードでQ&A、テーマを検索する

特集


より良い社会へ。感謝経済プロジェクト始動

ピックアップ

ページ先頭へ