エクセルのマクロの質問です。来店客の購入履歴を「来店記録」、会員登録してもらった顧客情報を「顧客名簿」というファイルに記録しています。「来店記録」内で入力した顧客に関する名前、会員番号等のキーワードを「顧客名簿」から探し出すという顧客検索マクロを作りたいと考えています。現在はオートフィルタ機能のオプションで検索しています。全角/半角スペースがある場合には”?”を入れたりしていて手間取ります。店頭で顧客に対応する時、即時性が求められるので操作のステップ数を減らしたいと思います。

マクロの知識が浅いため、解決方法そのものを教えていただければうれしいです。もしそのまま使える完全なコードややり方を回答していただいた回答者の方には500ポイントを差し上げます。よろしくお願いいたします。
※文字制限のため「顧客名簿」のサンプルデータ、仕様の詳細はこの下にある「この質問・回答へのコメント」に記載いたします。

回答の条件
  • 1人5回まで
  • 登録:2008/05/25 20:55:01
  • 終了:2008/06/01 02:39:47

ベストアンサー

id:SALINGER No.3

SALINGER回答回数3454ベストアンサー獲得回数9692008/05/31 12:42:34

ポイント750pt

Mookさんのコードに手を入れさせていただいて、条件に合うようにしてみるとこんな感じかな。

電話番号の為に101列目を使いました。

Sub MacroClientSearch()
    '顧客名簿のパスを環境に合わせてください
    Const myPath As String = "C:\Documents and Settings\hogehoge\デスクトップ\顧客名簿.xls"
    '顧客名簿のブック名
    Const wbName As String = "顧客名簿.xls"
    '顧客名簿のワークシート名
    Const wsName As String = "顧客名簿"
    
    Dim srcWS As Worksheet  '--- 検索元シート
    Dim dstWS As Worksheet  '--- 検索先シート
    Dim srcTitle As String  '--- 検索タイトル
    Dim dstTitleRange As Range  '--- 検索先タイトル
    Dim dstTitleRangeBK As Range  '--- 検索先タイトル保存用
    Dim searchWord As String    '--- 検索ワード
    Dim searchWordBK As String  '--- 検索ワード保存用
    Dim count As Long           '--- 検索ヒット数

'--- 作業用変数
    Dim sWord As Variant
    Dim swords As Variant
    Dim lastRow As Long
    Dim i As Long
    Dim rg As Range

'--- 複数セル選択した場合のエラー処理
    If Selection.count <> 1 Then
        MsgBox ("複数のセルが選択されています。")
        Exit Sub
    End If
    
    Set srcWS = ActiveSheet
        
    srcTitle = srcWS.Cells(1, Selection.Column).Value
    searchWord = Selection.Value
'--- タイトル列がない場合の処理
    If Len(srcTitle) = 0 Then
        MsgBox searchWord & "の列名は存在しません。検索場所を確認してください。"
        Exit Sub
    End If
    
    On Error GoTo Err_Mes
    If bookCheck(myPath) Then
        Set dstWS = Workbooks(wbName).Worksheets(wsName)
    Else
        Set dstWS = Workbooks.Open(myPath).Worksheets(wsName)
    End If
    On Error GoTo 0
    
'--- 検索先にタイトル列がない場合の処理
    Set dstTitleRange = dstWS.Rows(1).Find(what:=srcTitle, lookat:=xlWhole)
    If dstTitleRange Is Nothing Then
        MsgBox searchWord & "の列名は存在しません。検索場所を確認してください。"
        Exit Sub
    End If
        
'--- 検索語の準備処理
    Select Case dstTitleRange.Value
    Case "会員番号"
        searchWord = StrConv(searchWord, vbNarrow)
    Case "旧会員番号"
        searchWord = StrConv(searchWord, vbNarrow)
        searchWordBK = searchWord
        Set dstTitleRangeBK = dstTitleRange
        dstWS.Columns(100).Clear
        dstWS.Cells(1, 100).Value = "○"
        swords = Split(searchWord, "/")
        lastRow = dstWS.Cells(Rows.count, dstTitleRange.Column).End(xlUp).Row
        For Each sWord In swords
            For i = 2 To lastRow
                If InStr("/" & dstWS.Cells(i, dstTitleRange.Column) & "/", "/" & Trim(CStr(sWord)) & "/") > 0 Then
                    dstWS.Cells(i, 100).Value = "○"
                End If
            Next
        Next
        searchWord = "○"
        Set dstTitleRange = dstWS.Cells(1, 100)
    Case "名前", "フリガナ"
        searchWord = Replace(searchWord, " ", "*")   '--- 半角スペースの置換
        searchWord = Replace(searchWord, " ", "*")  '--- 全角スペースの置換
    Case "電話番号"
        searchWord = haifun(searchWord)
        searchWordBK = searchWord
        Set dstTitleRangeBK = dstTitleRange
        dstWS.Columns(101).Clear
        dstWS.Cells(1, 101).Value = "○"
        lastRow = dstWS.Cells(Rows.count, dstTitleRange.Column).End(xlUp).Row
        For i = 2 To lastRow
            swords = Split(dstWS.Cells(i, dstTitleRange.Column).Value, "/")
            For Each sWord In swords
                If haifun(CStr(sWord)) = searchWord Then
                    dstWS.Cells(i, 101).Value = "○"
                End If
            Next
        Next
        searchWord = "○"
        Set dstTitleRange = dstWS.Cells(1, 101)
    Case "メール", "携帯メール"
        searchWord = StrConv(searchWord, vbNarrow)
    Case Else
        MsgBox searchWord & "の列名は存在しません。検索場所を確認してください。"
        Exit Sub
    End Select
    
    
'--- 検索処理
    dstWS.Activate
    If dstWS.AutoFilterMode = True Then
        dstWS.Range("A1").AutoFilter
    End If
    dstWS.Columns(dstTitleRange.Column).AutoFilter Field:=1, Criteria1:=searchWord
    
    lastRow = dstWS.Cells(Rows.count, dstTitleRange.Column).End(xlUp).Row
    If dstTitleRange.Column = 100 Or dstTitleRange.Column = 101 Then
        searchWord = searchWordBK
        Set dstTitleRange = dstTitleRangeBK
    End If
    
'--- 検索結果がない場合
    If lastRow = 1 Then
        MsgBox "検索キーワード「" & searchWord & "」に該当する行は見つかりませんでした。" _
            & "検索条件を変えてみてください。"
        dstWS.Range("A1").AutoFilter
        srcWS.Activate
        Exit Sub
    End If
    
'--- 検索結果があった場合
    dstTitleRange.Offset(1).Resize(lastRow - 1, 1).SpecialCells(xlVisible).Select
    For Each rg In Selection
        count = count + 1
    Next
    If MsgBox("検索キーワード「" & searchWord & "」に該当する " & count & " 行を表示しました。" _
         & vbNewLine & "最初のページに戻りますか?" & vbNewLine & _
         "[はい]→最初のページに戻って検索をやり直す/検索を終了する。" & vbNewLine & _
         "[いいえ]→このページの検索結果を確認する。", _
         vbYesNo, "最初のページに戻りますか?") = vbYes Then
        dstWS.Range("A1").AutoFilter
        srcWS.Activate
    End If
    Exit Sub
    
Err_Mes:
    Select Case Err.Number
        Case 1004
            MsgBox "顧客管理をオープンできません。パスを確認してください。"
        Case 9
            MsgBox "顧客管理の正しいブック名とシート名を指定してください。"
        Case Else
            MsgBox "顧客管理をオープンすることができませんでした。"
    End Select
End Sub

'ブックが開いているかをチェック
Function bookCheck(myPath As String) As Boolean
    Dim f As Boolean
    Dim myBook As Workbook
    For Each myBook In Workbooks
        If myBook.Path & "\" & myBook.Name = myPath Then
            f = True
            Exit For
        End If
    Next
    bookCheck = f
End Function

'半角にして-を削除
Function haifun(str As String) As String
    str = StrConv(str, vbNarrow)
    str = Replace(str, "-", "")
    str = Replace(str, "―", "")
    str = Replace(str, "ー", "")
    str = Replace(str, "-", "")
    haifun = str
End Function

コード中の「\」は¥(半角)に置き換えてください。

その他の回答(2件)

id:Mook No.1

Mook回答回数1312ベストアンサー獲得回数3912008/05/25 23:18:29

ポイント750pt

ほとんど SALINGER さん以外は正確な状況を把握できないと思いますが、

面白そうなので下記のコメントの範囲で回答してみました。


きっと、SALINGERさんの完璧な回答がつくとは思いますが、いろいろなやり方があるということで。


Option Explicit

Sub MacroClientSearch()
    Dim srcWS As Worksheet  '--- 検索元シート
    Dim dstWS As Worksheet  '--- 検索先シート
    Dim srcTitle As String  '--- 検索タイトル
    Dim dstTitleRange As Range  '--- 検索先タイトル
    Dim dstTitleRangeBK As Range  '--- 検索先タイトル保存用
    Dim searchWord As String    '--- 検索ワード
    Dim searchWordBK As String  '--- 検索ワード保存用
    Dim count As Long           '--- 検索ヒット数

'--- 作業用変数
    Dim sWord As Variant
    Dim swords As Variant
    Dim lastRow As Long
    Dim i As Long
    Dim rg As Range

'--- 複数セル選択した場合のエラー処理
    If Selection.count <> 1 Then
        MsgBox ("複数のセルが選択されています。")
        Exit Sub
    End If
    
    Set srcWS = ActiveSheet
    Set dstWS = Worksheets("顧客名簿")
    
    srcTitle = srcWS.Cells(1, Selection.Column).Value
    searchWord = Selection.Value
'--- タイトル列がない場合の処理
    If Len(srcTitle) = 0 Then
        MsgBox searchWord & "の列名は存在しません。検索場所を確認してください。"
        Exit Sub
    End If
    
'--- 検索先にタイトル列がない場合の処理
    Set dstTitleRange = dstWS.Rows(1).Find(what:=srcTitle, lookat:=xlWhole)
    If dstTitleRange Is Nothing Then
        MsgBox searchWord & "の列名は存在しません。検索場所を確認してください。"
        Exit Sub
    End If
        
'--- 検索語の準備処理
    Select Case dstTitleRange.Value
    Case "会員番号"
    Case "旧会員番号"
        searchWordBK = searchWord
        Set dstTitleRangeBK = dstTitleRange
        dstWS.Columns(100).Clear
        dstWS.Cells(1, 100).Value = "○"
        swords = Split(searchWord, "/")
        lastRow = dstWS.Cells(Rows.count, dstTitleRange.Column).End(xlUp).Row
        For Each sWord In swords
            For i = 2 To lastRow
                If InStr("/" & dstWS.Cells(i, dstTitleRange.Column) & "/", "/" & Trim(sWord) & "/") > 0 Then
                    dstWS.Cells(i, 100).Value = "○"
                End If
            Next
        Next
        searchWord = "○"
        Set dstTitleRange = dstWS.Cells(1, 100)
    Case "名前", "フリガナ"
        searchWord = Replace(searchWord, " ", "*")   '--- 半角スペースの置換
        searchWord = Replace(searchWord, " ", "*")  '--- 全角スペースの置換
    Case "電話番号"
        searchWord = Replace(searchWord, "-", "?")   '--- 半角ハイフンの置換
        searchWord = Replace(searchWord, "―", "?")  '--- 全角ハイフンの置換
    Case "メール", "携帯メール"
    Case Else
        MsgBox searchWord & "の列名は存在しません。検索場所を確認してください。"
        Exit Sub
    End Select
    
    
'--- 検索処理
    dstWS.Activate
    If dstWS.AutoFilterMode = True Then
        dstWS.Range("A1").AutoFilter
    End If
    dstWS.Columns(dstTitleRange.Column).AutoFilter Field:=1, Criteria1:=searchWord
    
    lastRow = dstWS.Cells(Rows.count, dstTitleRange.Column).End(xlUp).Row
    If dstTitleRange.Column = 100 Then
        searchWord = searchWordBK
        Set dstTitleRange = dstTitleRangeBK
    End If
    
'--- 検索結果がない場合
    If lastRow = 1 Then
        MsgBox "検索キーワード「" & searchWord & "」に該当する行は見つかりませんでした。" _
            & "検索条件を変えてみてください。"
        dstWS.Range("A1").AutoFilter
        srcWS.Activate
        Exit Sub
    End If
    
'--- 検索結果があった場合
    dstTitleRange.Offset(1).Resize(lastRow - 1, 1).SpecialCells(xlVisible).Select
    For Each rg In Selection
        count = count + 1
    Next
    If MsgBox("検索キーワード「" & searchWord & "」に該当する " & count & " 行を表示しました。" _
         & vbNewLine & "最初のページに戻りますか?", _
         vbYesNo, "最初のページに戻りますか?") = vbYes Then
        dstWS.Range("A1").AutoFilter
        srcWS.Activate
    End If
End Sub

若干不安な点があるので、何点かコメントです。

・これまでのSALINGER さんの回答から判断すると、一つのファイル内で処理をしているように見え

ましたので、今回もそのように作成しています。

 ただ、質問文を読むと複数ファイルがあるように書かれています。

その場合、各ファイル名とシート名がはっきりしないと回答できませんでしたので、今回は各名称を

シート名と解釈しています。


・旧会員番号は、通常のフィルタ(3項目以上は不可)では処理できませんので、作業列(100列目)を

使用しています。このためこの項目はフィルタマークが見えません。


もし修正すべき点がありましたら、コメントください。

id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692008/05/26 17:58:56

今回顧客名簿を照会するファイルは異なるブックということなので、その部分だけを作ってみました。

コード自体はMookさんのコードがすばらしかったのでそのまま転用させていただきました。

通販管理、来店記録それぞれのブックの標準モジュールにコピペしてください。

便宜上、顧客名簿のブック名を「顧客名簿.xls」(拡張子が表示されない設定ならば「顧客名簿」にしてください。)

顧客名簿があるシートを「顧客名簿」としています。

コードの最初の部分をお使いの環境に変更してください。

Option Explicit

Sub MacroClientSearch()
    '顧客名簿のパスを環境に合わせてください
    Const myPath As String = "C:\Documents and Settings\hogehoge\デスクトップ\顧客名簿.xls"
    '顧客名簿のブック名
    Const wbName As String = "顧客名簿.xls"
    '顧客名簿のワークシート名
    Const wsName As String = "顧客 名簿"
    
    Dim srcWS As Worksheet  '--- 検索元シート
    Dim dstWS As Worksheet  '--- 検索先シート
    Dim srcTitle As String  '--- 検索タイトル
    Dim dstTitleRange As Range  '--- 検索先タイトル
    Dim dstTitleRangeBK As Range  '--- 検索先タイトル保存用
    Dim searchWord As String    '--- 検索ワード
    Dim searchWordBK As String  '--- 検索ワード保存用
    Dim count As Long           '--- 検索ヒット数

'--- 作業用変数
    Dim sWord As Variant
    Dim swords As Variant
    Dim lastRow As Long
    Dim i As Long
    Dim rg As Range

'--- 複数セル選択した場合のエラー処理
    If Selection.count <> 1 Then
        MsgBox ("複数のセルが選択されています。")
        Exit Sub
    End If
    
    Set srcWS = ActiveSheet
        
    srcTitle = srcWS.Cells(1, Selection.Column).Value
    searchWord = Selection.Value
'--- タイトル列がない場合の処理
    If Len(srcTitle) = 0 Then
        MsgBox searchWord & "の列名は存在しません。検索場所を確認してください。"
        Exit Sub
    End If
    
    On Error GoTo Err_Mes
    If bookCheck(myPath) Then
        Set dstWS = Workbooks(wbName).Worksheets(wsName)
    Else
        Set dstWS = Workbooks.Open(myPath).Worksheets(wsName)
    End If
    On Error GoTo 0
    
'--- 検索先にタイトル列がない場合の処理
    Set dstTitleRange = dstWS.Rows(1).Find(what:=srcTitle, lookat:=xlWhole)
    If dstTitleRange Is Nothing Then
        MsgBox searchWord & "の列名は存在しません。検索場所を確認してください。"
        Exit Sub
    End If
        
'--- 検索語の準備処理
    Select Case dstTitleRange.Value
    Case "会員番号"
    Case "旧会員番号"
        searchWordBK = searchWord
        Set dstTitleRangeBK = dstTitleRange
        dstWS.Columns(100).Clear
        dstWS.Cells(1, 100).Value = "○"
        swords = Split(searchWord, "/")
        lastRow = dstWS.Cells(Rows.count, dstTitleRange.Column).End(xlUp).Row
        For Each sWord In swords
            For i = 2 To lastRow
                If InStr("/" & dstWS.Cells(i, dstTitleRange.Column) & "/", "/" & Trim(sWord) & "/") > 0 Then
                    dstWS.Cells(i, 100).Value = "○"
                End If
            Next
        Next
        searchWord = "○"
        Set dstTitleRange = dstWS.Cells(1, 100)
    Case "名前", "フリガナ"
        searchWord = Replace(searchWord, " ", "*")   '--- 半角スペースの置換
        searchWord = Replace(searchWord, " ", "*")  '--- 全角スペースの置換
    Case "電話番号"
        searchWord = Replace(searchWord, "-", "?")   '--- 半角ハイフンの置換
        searchWord = Replace(searchWord, "―", "?")  '--- 全角ハイフンの置換
    Case "メール", "携帯メール"
    Case Else
        MsgBox searchWord & "の列名は存在しません。検索場所を確認してください。"
        Exit Sub
    End Select
    
    
'--- 検索処理
    dstWS.Activate
    If dstWS.AutoFilterMode = True Then
        dstWS.Range("A1").AutoFilter
    End If
    dstWS.Columns(dstTitleRange.Column).AutoFilter Field:=1, Criteria1:=searchWord
    
    lastRow = dstWS.Cells(Rows.count, dstTitleRange.Column).End(xlUp).Row
    If dstTitleRange.Column = 100 Then
        searchWord = searchWordBK
        Set dstTitleRange = dstTitleRangeBK
    End If
    
'--- 検索結果がない場合
    If lastRow = 1 Then
        MsgBox "検索キーワード「" & searchWord & "」に該当する行は見つかりませんでした。" _
            & "検索条件を変えてみてください。"
        dstWS.Range("A1").AutoFilter
        srcWS.Activate
        Exit Sub
    End If
    
'--- 検索結果があった場合
    dstTitleRange.Offset(1).Resize(lastRow - 1, 1).SpecialCells(xlVisible).Select
    For Each rg In Selection
        count = count + 1
    Next
    If MsgBox("検索キーワード「" & searchWord & "」に該当する " & count & " 行を表示しました。" _
         & vbNewLine & "最初のページに戻りますか?", _
         vbYesNo, "最初のページに戻りますか?") = vbYes Then
        dstWS.Range("A1").AutoFilter
        srcWS.Activate
    End If
    Exit Sub
    
Err_Mes:
    Select Case Err.Number
        Case 1004
            MsgBox "顧客管理をオープンできません。パスを確認してください。"
        Case 9
            MsgBox "顧客管理の正しいブック名とシート名を指定してください。"
        Case Else
            MsgBox "顧客管理をオープンすることができませんでした。"
    End Select
End Sub

'ブックが開いているかをチェック
Function bookCheck(myPath As String) As Boolean
    Dim f As Boolean
    Dim myBook As Workbook
    For Each myBook In Workbooks
        If myBook.Path & "\" & myBook.Name = myPath Then
            f = True
            Exit For
        End If
    Next
    bookCheck = f
End Function
id:icta

> SALINGERさん

ご回答ありがとうございます。

希望通りの動作を確認できました。

本当にありがとうございます。

最後に一点だけ思わぬ動作をするところがあるのでこの部分の修正をすることは可能でしょうか?

会員カードを忘れた顧客から会員番号の問合せを受けることがあります。

この場合「顧客名簿」の最終行に検索キーワードを入力し、マクロを実行します。

▼以下のメッセージが表示され、[はい]を選択すると、検索キーワードを入力したセルに戻らず、いちばん上の1行目から表示されます。

 最初のページに戻りますか?

 [はい]→最初のページに戻って検索をやり直す/検索を終了する。

 [いいえ]→このページの検索結果を確認する。”

 [はい][いいえ]

 

これだと次の検索を始める時に毎回最終行まで戻らなければなりません。

1万行ほどあるため、最終行まで戻るのが面倒です。

[はい]を選択しても検索を始めたセルに戻ることは可能でしょうか?

なお検索キーワードを含む行が検索ページ内にあると、このようなことは生じません。

行数が1ページを超える場合にこのようになります。

お手数をおかけしますがチェックしてみていただいてもよろしいでしょうか。

よろしくお願いいたします。

2008/05/31 19:56:23
id:SALINGER No.3

SALINGER回答回数3454ベストアンサー獲得回数9692008/05/31 12:42:34ここでベストアンサー

ポイント750pt

Mookさんのコードに手を入れさせていただいて、条件に合うようにしてみるとこんな感じかな。

電話番号の為に101列目を使いました。

Sub MacroClientSearch()
    '顧客名簿のパスを環境に合わせてください
    Const myPath As String = "C:\Documents and Settings\hogehoge\デスクトップ\顧客名簿.xls"
    '顧客名簿のブック名
    Const wbName As String = "顧客名簿.xls"
    '顧客名簿のワークシート名
    Const wsName As String = "顧客名簿"
    
    Dim srcWS As Worksheet  '--- 検索元シート
    Dim dstWS As Worksheet  '--- 検索先シート
    Dim srcTitle As String  '--- 検索タイトル
    Dim dstTitleRange As Range  '--- 検索先タイトル
    Dim dstTitleRangeBK As Range  '--- 検索先タイトル保存用
    Dim searchWord As String    '--- 検索ワード
    Dim searchWordBK As String  '--- 検索ワード保存用
    Dim count As Long           '--- 検索ヒット数

'--- 作業用変数
    Dim sWord As Variant
    Dim swords As Variant
    Dim lastRow As Long
    Dim i As Long
    Dim rg As Range

'--- 複数セル選択した場合のエラー処理
    If Selection.count <> 1 Then
        MsgBox ("複数のセルが選択されています。")
        Exit Sub
    End If
    
    Set srcWS = ActiveSheet
        
    srcTitle = srcWS.Cells(1, Selection.Column).Value
    searchWord = Selection.Value
'--- タイトル列がない場合の処理
    If Len(srcTitle) = 0 Then
        MsgBox searchWord & "の列名は存在しません。検索場所を確認してください。"
        Exit Sub
    End If
    
    On Error GoTo Err_Mes
    If bookCheck(myPath) Then
        Set dstWS = Workbooks(wbName).Worksheets(wsName)
    Else
        Set dstWS = Workbooks.Open(myPath).Worksheets(wsName)
    End If
    On Error GoTo 0
    
'--- 検索先にタイトル列がない場合の処理
    Set dstTitleRange = dstWS.Rows(1).Find(what:=srcTitle, lookat:=xlWhole)
    If dstTitleRange Is Nothing Then
        MsgBox searchWord & "の列名は存在しません。検索場所を確認してください。"
        Exit Sub
    End If
        
'--- 検索語の準備処理
    Select Case dstTitleRange.Value
    Case "会員番号"
        searchWord = StrConv(searchWord, vbNarrow)
    Case "旧会員番号"
        searchWord = StrConv(searchWord, vbNarrow)
        searchWordBK = searchWord
        Set dstTitleRangeBK = dstTitleRange
        dstWS.Columns(100).Clear
        dstWS.Cells(1, 100).Value = "○"
        swords = Split(searchWord, "/")
        lastRow = dstWS.Cells(Rows.count, dstTitleRange.Column).End(xlUp).Row
        For Each sWord In swords
            For i = 2 To lastRow
                If InStr("/" & dstWS.Cells(i, dstTitleRange.Column) & "/", "/" & Trim(CStr(sWord)) & "/") > 0 Then
                    dstWS.Cells(i, 100).Value = "○"
                End If
            Next
        Next
        searchWord = "○"
        Set dstTitleRange = dstWS.Cells(1, 100)
    Case "名前", "フリガナ"
        searchWord = Replace(searchWord, " ", "*")   '--- 半角スペースの置換
        searchWord = Replace(searchWord, " ", "*")  '--- 全角スペースの置換
    Case "電話番号"
        searchWord = haifun(searchWord)
        searchWordBK = searchWord
        Set dstTitleRangeBK = dstTitleRange
        dstWS.Columns(101).Clear
        dstWS.Cells(1, 101).Value = "○"
        lastRow = dstWS.Cells(Rows.count, dstTitleRange.Column).End(xlUp).Row
        For i = 2 To lastRow
            swords = Split(dstWS.Cells(i, dstTitleRange.Column).Value, "/")
            For Each sWord In swords
                If haifun(CStr(sWord)) = searchWord Then
                    dstWS.Cells(i, 101).Value = "○"
                End If
            Next
        Next
        searchWord = "○"
        Set dstTitleRange = dstWS.Cells(1, 101)
    Case "メール", "携帯メール"
        searchWord = StrConv(searchWord, vbNarrow)
    Case Else
        MsgBox searchWord & "の列名は存在しません。検索場所を確認してください。"
        Exit Sub
    End Select
    
    
'--- 検索処理
    dstWS.Activate
    If dstWS.AutoFilterMode = True Then
        dstWS.Range("A1").AutoFilter
    End If
    dstWS.Columns(dstTitleRange.Column).AutoFilter Field:=1, Criteria1:=searchWord
    
    lastRow = dstWS.Cells(Rows.count, dstTitleRange.Column).End(xlUp).Row
    If dstTitleRange.Column = 100 Or dstTitleRange.Column = 101 Then
        searchWord = searchWordBK
        Set dstTitleRange = dstTitleRangeBK
    End If
    
'--- 検索結果がない場合
    If lastRow = 1 Then
        MsgBox "検索キーワード「" & searchWord & "」に該当する行は見つかりませんでした。" _
            & "検索条件を変えてみてください。"
        dstWS.Range("A1").AutoFilter
        srcWS.Activate
        Exit Sub
    End If
    
'--- 検索結果があった場合
    dstTitleRange.Offset(1).Resize(lastRow - 1, 1).SpecialCells(xlVisible).Select
    For Each rg In Selection
        count = count + 1
    Next
    If MsgBox("検索キーワード「" & searchWord & "」に該当する " & count & " 行を表示しました。" _
         & vbNewLine & "最初のページに戻りますか?" & vbNewLine & _
         "[はい]→最初のページに戻って検索をやり直す/検索を終了する。" & vbNewLine & _
         "[いいえ]→このページの検索結果を確認する。", _
         vbYesNo, "最初のページに戻りますか?") = vbYes Then
        dstWS.Range("A1").AutoFilter
        srcWS.Activate
    End If
    Exit Sub
    
Err_Mes:
    Select Case Err.Number
        Case 1004
            MsgBox "顧客管理をオープンできません。パスを確認してください。"
        Case 9
            MsgBox "顧客管理の正しいブック名とシート名を指定してください。"
        Case Else
            MsgBox "顧客管理をオープンすることができませんでした。"
    End Select
End Sub

'ブックが開いているかをチェック
Function bookCheck(myPath As String) As Boolean
    Dim f As Boolean
    Dim myBook As Workbook
    For Each myBook In Workbooks
        If myBook.Path & "\" & myBook.Name = myPath Then
            f = True
            Exit For
        End If
    Next
    bookCheck = f
End Function

'半角にして-を削除
Function haifun(str As String) As String
    str = StrConv(str, vbNarrow)
    str = Replace(str, "-", "")
    str = Replace(str, "―", "")
    str = Replace(str, "ー", "")
    str = Replace(str, "-", "")
    haifun = str
End Function

コード中の「\」は¥(半角)に置き換えてください。

  • id:icta
    この質問は
    http://q.hatena.ne.jp/1210836514
    http://q.hatena.ne.jp/1210860623
    http://q.hatena.ne.jp/1210901281
    http://q.hatena.ne.jp/1210987314
    http://q.hatena.ne.jp/1211105656
    の派生質問です。
    データを記録するのはエクセルの知識がほとんどない販売スタッフです。
    データベースソフトを使えればよいのですが以前業者に依頼したものは導入に失敗しました。
    作業が煩雑になったのと各店舗に散らばるスタッフへの教育が難しく変更に対応できなかったためです。
    そのため現行作業をあまり変えることなく行うのが今回の方針です。
    お知恵とお力をお借りできれば幸いです。
    仕様で何かご不明な点ありましたらお知らせください。

    ■「顧客名簿検索」仕様

    ○概要
    ファイルに顧客の会員番号、旧会員番号、名前、フリガナ、メール、携帯メール、電話番号のいずれかを記載。そのセルを選択してマクロを実行するとそのセルのタイトル行(先頭行)の列名を調べ、「顧客名簿」の同じ列名から該当する顧客情報の行をすべて表示する。
    ○詳細
    ◇マクロの実行
    検索したいキーワードを選択してマクロを実行、選択したセルのタイトル行の列名を調べる。
    もし"名前"列であれば、「顧客名簿」のタイトル行(先頭行)の”名前”と一致する列から、キーワードと一致する行をすべて表示する(オートフィルタウインドウ(オートフィルタのオプション)に入力して得られる表示と同じ方法)。

    ◇検索方法
    検索方法は列名によって▼次の方法を採る。
    ※”会員番号”列、”フリガナ”列、”メール”列、”携帯メール”列
    完全に一致する行をすべて表示する。
    ※”旧会員番号”列
    これまでは顧客が会員証を忘れたり、失くしたりすると新しい番号を作ったために複数の番号を持つ人がいる。
    複数の番号は「顧客名簿」に”D500/345/0326”のようにスラッシュ区切りでセルに納められている。
    このためD500でも0326でも検索キーワードを含む行をすべて表示する。
    ※”名前”列
    姓と名の間に空白スペース(全角、半角)が入っている可能性があるのでスペースはワイルドカード”?”に置き換えて該当する行をすべて表示する。
    例:山本 太郎 → 山本?太郎
    ※”電話番号”列
    半角、全角のハイフンが入っている可能性があるので”-””-”はワイルドカード”?”に置き換えて該当する行をすべて表示する。
    ◇メッセージの表示
    該当する行を表示する時に▼次のメッセージを表示する。
    タイトル:最初のページに戻りますか?
    ”検索キーワード「×××」に該当するn行を表示しました。
     最初のページに戻りますか?
     [はい]→最初のページに戻って検索をやり直す/最初のページに戻って検索を終了する。
     [いいえ]→検索結果を確認する。”

    ※×××は検索キーワード。n行は検索した結果得られた行数。0のときは”検索キーワード「×××」に該当するn行を表示しました。”の部分を”検索キーワード「×××」に該当する行は見つかりませんでした。検索方法を変えてみてください。”と表示する。
    ※[はい]をクリックした場合は、検索を始めたページでマクロを実行したセル位置に戻る。
    ※「顧客名簿」を照会するファイルは様々あり異なるブックなので、マクロを実行した時にブック名とシート名とセル位置を覚えておく。
    ※「顧客名簿」に検索キーワードを入力して検索する場合もあり、その場合は[はい][いいえ]どちらをクリックしても「顧客名簿」のマクロを実行した時のセル位置に戻る。
    ※[いいえ]をクリックした場合は該当行を表示したままで「顧客名簿」を表示する。

    ◇その他
    ※「顧客名簿」はマクロを実行する前にオートフィルタが働いている可能性があるのでマクロ実行直後にフィルタを外す。
    ※選択したセルのタイトル行の列名が「顧客名簿」のタイトル行に存在しない場合、”「顧客名簿」には”△△の列名は存在しません。検索場所を確認してください”というメッセージを表示する。△△は選択したセルの列名。
     
    ◇サンプルデータ
    「顧客名簿」
    8 C00102 C102/0503 正 松田聖子 マツダセイコ 227-0033 神奈川県xxxxxx 090-xxx-1234 aaaa@bbb.ne.jp AAA@docomo.ne.jp 2005/12/26 2008/5/22
    9 T03224 03224 仮 中森 明菜 ナカモリアキナ 939-1104 富山県xxxxxx 0766xxxxxx ccc@ddd.ne.jp CCC@ezweb.ne.jp 2005/12/26 2008/5/22 2008/3/31-2009/3/30
    10 L00502 L502 正 近藤真彦 コンドウ 111-0001 東京都XXXXX 080xxxxx dddd@eeee.com DDDD@softbank.ne.jp 2003/4/4 2008/5/22
    11 T00123 正 間津田 誠子 マツダセイコ 123-4567 岐阜県XXXX 057-XXX-0123 eeee@ffff.net FFFF@vodafone.ne.jp 2001/1/1 2007/4/1

    「来店記録」
    店舗 会員番号 旧会員番号 会員資格 名前 フリガナ 来店日 担当 売上
    上野 C00102 C102/0503 正 原田知世 ハラダトモヨ 2008/5/11 吉田 15000
    上野 正 近藤 真彦 コンドウマサヒコ 2008/5/11 吉田 6000
    新宿 仮 松田 聖子 マツダセイコ 2008/5/12 長岡 -6000
    新宿 C03825 3825 正 中森 明菜 ナカモリアキナ 2008/5/12 吉田 12000

    「通販管理」
    連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 登録日
    7848 C102 松田 聖子 マツダセイコ 227-0033 神奈川県xxxxxx 090-xxx-1234 aaaa@bbb.ne.jp 2008/3/1
    7849 T03224 中森 明菜 ナカモリアキナ 939-1104 富山県xxxxxx 0766xxxxxx ccc@ddd.ne.jp 2008/3/2
    7850 近藤真彦 コンドウ 111-0001 東京都XXXXX 080xxxxx dddd@eeee.com 2008/3/3


    ◇実際の運用

    ※例1
    「来店記録」”名前”列の松田 聖子をクリック
    ”名前”なので全角スペースにワイルドカード”?”を入れ、”松田?聖子”で「顧客名簿」を検索
    ↓「顧客名簿」の松田聖子の1行のみが表示される。
    連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 携帯メール
    8 C00102 C102/0503 正 松田聖子 マツダセイコ 227-0033 神奈川県xxxxxx 090-xxx-1234 aaaa@bbb.ne.jp AAA@docomo.ne.jp

    ”検索キーワード「松田 聖子」に該当する1行を表示しました。”

    ※例2
    「来店記録」”フリガナ”列のマツダセイコをクリック
    ↓「顧客名簿」のマツダセイコに該当する2行が表示される。
    連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 携帯メール
    8 C00102 C102/0503 正 松田聖子 マツダセイコ 227-0033 神奈川県xxxxxx 090-xxx-1234 aaaa@bbb.ne.jp AAA@docomo.ne.jp
    11 T00123 正 間津田 誠子 マツダセイコ 123-4567 岐阜県XXXX 057-XXX-0123 eeee@ffff.net FFFF@vodafone.ne.jp

    ”検索キーワード「マツダセイコ」に該当する2行を表示しました。”

    ※例3
    「来店記録」”名前”列の原田知世をクリック
    ↓「顧客名簿」に原田知世は存在しないので
    ”検索キーワード「原田知世」に該当する行は見つかりませんでした。検索方法を変えてみてください。”

    ※例4
    「通販管理」”旧会員番号”列の1行目のC102をクリック
    ”旧会員番号”列なので「顧客名簿」の”旧会員番号”列からC102を含む行を検索
    ↓「顧客名簿」"旧会員番号"列にC102を含む松田聖子の1行のみが表示される。
    連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 携帯メール
    8 C00102 C102/0503 正 松田聖子 マツダセイコ 227-0033 神奈川県xxxxxx 090-xxx-1234 aaaa@bbb.ne.jp AAA@docomo.ne.jp

    ”検索キーワード「C102」に該当する1行を表示しました。”

    ※例5
    「通販管理」”電話番号”列の1行目の090-xxx-1234をクリック
    ”電話番号”なのでハイフンをワイルドカード”?”に置換し、”090?xxx?1234”で「顧客名簿」を検索
    ↓「顧客名簿」”電話番号”列に090?xxx?1234を含む松田聖子の1行のみが表示される。
    連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 携帯メール
    8 C00102 C102/0503 正 松田聖子 マツダセイコ 227-0033 神奈川県xxxxxx 090-xxx-1234 aaaa@bbb.ne.jp AAA@docomo.ne.jp

    ”検索キーワード「090-xxx-1234」に該当する1行を表示しました。”
  • id:taknt
    >姓と名の間に空白スペース(全角、半角)が入っている可能性があるのでスペースはワイルドカード”?”に置き換えて該当する行をすべて表示する。

    半角、全角のどっちか入っているのが わからないというのは イマイチですね。

    もう既に入っているやつ 半角か全角のどちらかに置換してやればいい。
    そうすれば検索もラクだし あとで見直すときもラク。

    当然ながら 社員に教育しなくても 置換させることは可能。
    そこらへんは 考えればすぐ わかると思うけど。
  • id:Mook
    不規則な文字は厄介ですね。

    そういう意味で気になるのはメールや電話番号です。
    全角・半角やハイフン(-,ー,-,‐)も誤入力としてありがちなものです。

    電話番号は ? を使用しましたが、あったりなかったりというケースを想定するなら * の方がよいです。
    特に携帯番号は区切り位置が異なると ? ではマッチしなくなります。
    前者は1文字とマッチ(1文字無いといけない)ですが、後者は不特定文字(0以上)とマッチをします。

    フィルタではなく正規表現で処理という手も考えられそうです。
  • id:taknt
    Mookさん、最初に別の列に電話番号を置換しちゃったほうが 簡単だと思いますね。
    そのほうが 確実に検索できそうです。

    列数もあまってそうですし。
    いくつか検索用の列が増えてもいいんじゃないのかな。
    というか、もともとの電話番号の列を変更しちゃったほうが はやいんだけどな。
    統一のとれてないデータで管理する必要だってないだろうし。
  • id:icta
    >Mookさん
    >SALINGERさん
    早々のご回答ありがとうございました。
    希望通りの動作を確認いたしました。
    このマクロは複数のスタッフがいちばんよく使うものになります。
    実際に運用させてみて使い心地を聞いてみたいと思います。
    概ねこれで良いと思うのですが、エクセルをよく知らないスタッフに使わせてみると気が付かなかった改良点などを教えてくれるかもしれません。
    これまでの質問のように何度も修正をお願いしたりするのは心苦しいのでテスト&チェックに少し時間をかけてみたいと思います。
    終わりましたら改めて書き込みさせていただきます。
    そのときはまたよろしくお願いいたします。

    以下はコメントへの返信です。

    >ただ、質問文を読むと複数ファイルがあるように書かれています。

    本当はすべて別のブックで管理しています。
    ルールはブック名=シート名です。
    「顧客名簿」なら顧客名簿.xlsの顧客名簿シートとなります。
    「通販管理」なら通販管理.xlsの通販管理シートとなります。
    現在はテスト&チェックのしやすさから、一つのブックにまとめています。
    このマクロのテスト&チェックが終われば切り離すつもりです。
    各店舗で使用しているPCは古く低スペックのマシンなので大きなファイルだと動作が鈍くなってしまうためです。

    >全角・半角やハイフン(-,ー,-,‐)も誤入力としてありがちなものです。

    まさにそのとおりです。
    今回の改善でこのようなものをすべて置換しましたが、スタッフには全角/半角の違い、大文字/小文字、ハイフン/アンダーバー、ドット、カンマ/句読点の違いがよくわからないようです。
    こういう類の誤りは教育してもなかなか直るものではありません。
    ”XXーX@Nifty。Com ”という入力があったりします。

    >電話番号は ? を使用しましたが、あったりなかったりというケースを想定するなら * の方がよいです。

    ワイルドカードの使い方を間違えていました。
    おっしゃるとおり、*の方がよいですね。
  • id:Mook
    新しいデータが追加される環境では、せっかく修正しても新たな誤入力がありそうですね。

    ちょっとした工夫ですが、EXCEL にはIMEの入力モードを制御する機能もあります。
    http://www.relief.jp/itnote/archives/000111.php

    バージョンによって、動作がうまくいかない場合もあるようですが、
    http://www.relief.jp/itnote/archives/000111.php

    試してみる価値はあるかもしれません。
  • id:SALINGER
    7行目 顧客 名簿→顧客名簿
    と空白をとってください。デバック用に無効な名前を入れたのがそのままになってました。
  • id:icta


    > Mookさん

    > SALINGERさん

     

    ご返信が遅くなりまして申し訳ありません。

    テスト&チェックがようやく終了しました。

    スタッフにも大変好評でした。

     

    完璧なコードでほとんど変更点はありません。

    ただ実際にスタッフが使用しているのを見て気づいたことがいくつかありました。

    以下の点だけ取り込んでいただけるとさらに便利になり、不慣れなスタッフでも使いやすくなるように思います。

    お手数をおかけして申し訳ありませんがよろしくお願いいたします。。

     

    ◇電話番号の検索方法を変更

    今回データをまとめた結果、自宅電話番号と携帯電話番号の両方のデータが存在していた場合、"電話番号"列に「0123-45-6789/090-1234-5678」に収めることになりました。

    そのため"*"を用い、ハイフンのない"09012345678"でもハイフンが"0123ー45-6789"でも検索できるように変更できませんでしょうか?

     

    ◇全角が混じっても混じっても検索できる

    見ていると会員番号、旧会員番号、電話番号、メールにキーワードを打ち込むとき、全角文字で入力してしまうことがあるようです。後から気づいて直しても手間取ってしまうため、全角文字のままでもマクロが半角に直して「顧客名簿」を検索することは可能でしょうか?

    キーワードが09012345678、abc@xxx.comでも、「顧客名簿」では09012345678、abc@xxx.comで検索できれば、大変便利です。

    なおセルにはMookさんに教えていただいた入力制御はかけるようにしておきます。

     

    ◇メッセージの変更

    内容はくどくなりますが、初めて使う場合でもわかりやすいよう以下のようにメッセージを変更することは可能でしょうか?

    ※現在

    ”検索キーワード「×××」に該当するn行を表示しました。

     最初のページに戻りますか?

     [はい][いいえ]"

     

    ※変更後

    ”検索キーワード「×××」に該当するn行を表示しました。

     最初のページに戻りますか?

     [はい]→最初のページに戻って検索をやり直す/検索を終了する。

     [いいえ]→このページの検索結果を確認する。”

     [はい][いいえ]
  • id:Mook
    まず確認なのですが、検索語を入力する各シート上では全角、半角等の入力のブレはあっても、
    顧客名簿はすべて半角で正確に入力されていると仮定してよいのでしょうか。

    また、顧客名簿側に - がある電話番号を、数字だけから検索するのは難しいですから、検索の
    ための作業列が欲しい気がします。

    そのようなデータ列を作成するのは可能でしょうか。
  • id:Mook
    SALINGER さんので一応動作しそうですね。
    これでパフォーマンスに問題ないようでしたら、これでもよいかと思います。

    もし、動作的に電話番号検索が遅いようでしたら、先にコメントしたように電話番号を
    半角/ハイフン無しにした列を用意できれば速度の改善が期待できます。

    その際、電話番号の数が2つまででしたら、通常のオートフィルタ機能でできるので、
    それが一番スマートな気がします。

    まぁ、データ数が多くなく、最近のPCだったら問題ないとは思いますが。
  • id:icta
    > Mookさん

    > 顧客名簿はすべて半角で正確に入力されていると仮定してよいのでしょうか。
    今回の改善ですべて半角に統一しました。

    > そのようなデータ列を作成するのは可能でしょうか。

    はい、可能です。

    それではよろしくお願いいたします。
  • id:SALINGER
    顧客名簿の会員番号などに全角が含まれていた場合もあるので全てを作業列で処理するという方法も途中まで作りましたが、
    行数が数万行などと多い場合その都度作業列を作っていたら確かにレスポンスが悪くなりますね。
    電話番号を最初、1文字ずつに*を挟んでオートフィルターしようかとも思ったけど、
    例えば、「090-1234-5678」で「090-4567-8901/1234-015-678」とかもヒットしちゃう。
    必ず/があるなら、searchWord/* と */searchWord の or でオートフィルターができるけどね。
  • id:SALINGER
    参考までに作業列を使うパターンも作ってブログの方にアップしたので、重くなければどうぞ。
  • id:Mook
    すでに SALINGER さんがブログに回答されていますが、多様なやり方があるということで見ないで、機能を追加
    してみました(これから拝見させてもらいますね)。

    いつの間にか発言できなくなっていましたので、下記にアップしました(コードも大きいことですし)。
    http://briefcase.yahoo.co.jp/bc/mook6728/lst?.dir=e22d&srcbc&.view=
    の「custmerSearch.zip」をダウンロードしてください。
  • id:SALINGER
    2の回答にコメントがついていたことに気づきませんでした。
    顧客名簿に貼り付ければ顧客名簿から検索できることは薄々わかっていましたが、想定した使い方ではありませんでした。
    ブログの方にスクロールが戻るように3の回答を修正したのも、下の方に載せておきます。

    Mookさんのコードもぜひ拝見させてください。
  • id:Mook
    ブログの方を拝見しました。
    すべての項目に対して、半角化していたのは良いですね。
    私にはない発想でした。

    同じシートでの検索は私も想定していませんでした。
    その点は問題として残っていますので、SALINGER さんのを使用してください。

    私のは、オートフィルタを使うように変更しています。
    一つ工夫したのは、末尾までのマッチングにしているので、下4桁とか、市内局番以下
    でも検索できるようにしています。

    またデータが1万行もあるのも想定外でした。
    検索用の作業列を更新する場合も、全部ではなく更新した行だけにしたほうが良いですね。
    (もし使用する場合は、インデントのために全角スペースを使用しているので、
    半角に置換してください。)

    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Const PhoneCol = "H" '--- 顧客名簿の電話番号のデータ列
    Const PhoneWorkCol = 200 '--- 電話番号のデータ列

    Private Sub Worksheet_Change(ByVal Target As Range)
      If Intersect(Columns(PhoneCol), Target) Is Nothing Then Exit Sub

      Application.EnableEvents = False
      Dim rg As Range, pn As String
      For Each rg In Intersect(Columns(PhoneCol), Target)
        If rg.Row > 1 Then
          pn = "/" & rg.Value & "/"
          pn = StrConv(pn, vbNarrow)
          pn = Replace(pn, "-", "")
          pn = Replace(pn, "ー", "")
          pn = Replace(pn, "―", "")
          pn = Replace(pn, "‐", "")
          Cells(rg.Row, PhoneWorkCol).Value = pn
        End If
      Next
      Application.EnableEvents = True
    End Sub

    アップしたのは問題点があるので、修正してください。
      Application.EnableEvents を使用していない点と、
    Const の定義前に使用している点です。

    でも、このシートで検索するとなると、ちょっと変更が必要かもしれません。
  • id:icta
    > SALINGERさん
    > Mookさん

    希望通りの動作を確認できました。
    お二人のお力で大変使いやすいマクロになりとてもうれしいです。
    簡単にしかも早く検索でき、これまでかかっていた時間を大幅を短縮できそうです。
    本当にありがとうございました。
  • id:icta
    > SALINGERさん
    大変使いやすいマクロを作っていただき本当にありがとうございました。
    スタッフにも大変好評です。
    実は前回の機能追加修正のときには気が付かなかったのですが、変更したい点が2つほどあります。
    質問を締め切った後で大変心苦しいのですが、お力をお借りできませんでしょうか?

    ○検索終了後、オートフィルター機能をつける。
    これまでオートフィルタで検索してきたため、スタッフはこのやり方に慣れているようです。
    また住所、郵便番号で検索するときにはオートフィルタが便利みたいです。
    そのためオートフィルタを常に1行目に働かせておき、最終行で検索する現在の方法とオートフィルタの両方を使えるようにしたいと思います。

    最初の仕様では▼以下のように記載したのですが、これを以下のように変更することは可能でしょうか?
     ※「顧客名簿」はマクロを実行する前にオートフィルタが働いている可能性があるのでマクロ実行直後にフィルタを外す。
     ↓
     ※「顧客名簿」は検索終了後、1行目の列のタイトルが入っているセルにはすべてオートフィルタを働かせる。
      ”最初のページに戻りますか?”のメッセージが表示。
       [はい]→1行目にオートフィルタを働かせ、フィルタリングされている箇所は、すべて表示にする。
       [いいえ]→1行目にオートフィルタを働かせ、フィルタリングされている箇所はそのままにして表示する。

    ○会員番号は完全一致から前方一致にする
    住所、メール、苗字の変更が多く、同一人物でも住所、メールがどちらか新しいものかわからないことがよくあります。
    またメールを変更したとき新しく書き換えてしまうと過去のメールを調べるのが困難になってしまいます。
    そのため、▼次のようにルールを決めました。
    このルールのため会員番号に関しては”会員番号*”で前方一致で検索するように変更できればと思います。

    最新の住所と思われるもの以外には末尾に"x"をつける。
    例:
    会員番号 名前 住所 登録日
    1001 近藤 明菜 東京都XXX 2007/7/11
    1001x 中森 明菜 東京都XXX 2006/4/4
    1001x 中森 明菜 神奈川XXX 2005/1/3

    何度も修正をお願いして大変申し訳ありません。
    ご都合のよいときにチェックしていただければ幸いです。
  • id:icta
    > SALINGERさん
    1点、おかしな動作をするところがありましたのでご報告いたします。
    検索の時に用いられる100列目の○が前検索の結果が何かの組み合わせで残ってしまい、検索条件に該当しない前検索の内容が検索結果として同時に表示される場合があります。
    高い頻度で生じるのですが、どのようなときにこの現象が出るのか再現できないため、再現できましたらまた報告させていただきます。
    それではよろしくお願いいたします。
  • id:SALINGER
    ただ今、ブログの方を、修正しておきました。
    オートフィルターを常に表示したせいで、100列目まで矢印がついてしまいました。
    作業列を最終行とかにした方がいいかもしれませんね。
    100列目は毎回クリアしてるので前検索が残るとは思えないのですが、
    本来100列目だけでいいのに101列目も使ったせいかもしれません。
    そこは100列目だけにしておきました。
    どのようなときに起こるのかがわかれば(どの列で検索したとか)、コードの間違いを見つける手がかりになるのですが。
  • id:icta
    > SALINGERさん
    マクロの修正お手数をおかけして申し訳ありませんでした。
    タイトル行のオートフィルタで上からでもページ内からでも検索できるようになり大変便利になりました。
    本当にありがとうございます。

    > オートフィルターを常に表示したせいで、100列目まで矢印がついてしまいました。
    > 作業列を最終行とかにした方がいいかもしれませんね。

    オートフィルタを100列目まで矢印をつけても作業、マクロの実行スピードに影響なければ問題ないと思います。
    もし顧客数が2万、3万と増えた場合にオートフィルタの矢印の数のせいでこれらに支障がでるということであれば、できるかどうかわかりませんが矢印を何列目まで付けるという変数を設けた方が良いのかもしれませんね。

    > どのようなときに起こるのかがわかれば(どの列で検索したとか)、コードの間違いを見つける手がかりになるのですが。

    少し症状が異なるのですが同じような不具合の症状をようやく再現できましたのでご報告いたします。
    ▼”旧会員番号”が2度目の検索のとき該当行が表示されない。
    1)「来店記録」1行目森谷の”旧会員番号”を選択してマクロ実行
    2)「顧客名簿」で該当する行が表示され、メッセージで[いいえ]をクリック
    3)「来店記録」に戻り、今度は2行目の高橋の”旧会員番号”を選択してマクロを実行
    4)「顧客名簿」で「検索キーワードD056に該当する行は見つかりませんでした」と表示される
    5)「来店記録」に戻り、再度2行目の高橋の”旧会員番号”を選択してマクロを実行
    6)「顧客名簿」で今度は該当する行が見つかり、表示される。

    ▼「来店記録」サンプル ※来店記録の行数は2万行超
    連番 店舗 会員番号 旧会員番号 会員資格 名前 フリガナ 来店日 担当 売上
    21288 新宿 C01922 414/1922 正 森谷 モリヤ 2006/5/3 山田 4400
    21297 上野 D00056 D056 正 高橋 タカハシ 2006/5/3 鈴木 6640

    最後にもう1点だけ可能であれば修正をお願いしたいところがあります。
    最初の仕様から何度も変更して本当に申し訳ありません。
    実際に運用してみると最初の仕様からは思いもかけないことが起きたりして驚かされます。

    修正をお願いしたい箇所は名前とフリガナの検索方法です。
    現在は完全一致ですがこれを*名前*、*フリガナ*で文字列のどこにあっても検索できるように変更できればと思います。
    スタッフが実際に使っているのを見て気がついたのですが、例えば店舗に白鳥麗子さんという珍しい名前の方が来店され、会員証を忘れた時、スタッフがお名前を伺います。
    この場合、まず「白鳥」で名前を検索します。
    それは「白鳥」という苗字が鈴木や佐藤とは違って恐らく少ないだろうと考え、「麗子」まで入力せずとも表示されるだろうと推測するためです。
    「白鳥」で表示されない場合は結婚で苗字が変わった可能性があると考え、次は「麗子」で検索します。
    カタカナも同じような思考で検索を始めるため、完全一致だと検索に手間取ってしまうようです。
    質問終了後に何度も申し訳ありません。もう少し検証すべきでした。
    お手数をおかけして申し訳ありませんがお力をお借りできれば幸いです。
  • id:SALINGER
    修正しておきました。
    1度検索をして行を抽出した状態で、また検索をすることで起こる不具合でした。
    コードの最初のほうで全ての行を表示するようにして修正しました。
    また、名前、フリガナの仕様変更。
    作業列も定数にして、コードの最初のところで変更できるようにしてあります。
  • id:icta
    > SALINGERさん
    早々の修正ありがとうございます。
    お手数を取らせてしまって申し訳ありません。
    早速新しいコードで試してみたのですが、「来店記録」でマクロを実行した時に、[はい][いいえ]のメッセージが「顧客名簿」ではなく「来店記録」に出てしまいます。
    ▼こんな感じです。
    1)「来店記録」でマクロを実行
    2)「来店記録」で「最初のページに戻りますか?」のメッセージが表示
    3)[はい]→「顧客名簿」「来店記録」ともに変化なし。「来店記録」が表示されたまま。
      [いいえ]→「顧客名簿」の該当する行が表示。
    ▼希望する動作は最初と同じように
    1)「来店記録」でマクロを実行
    2)「顧客名簿」で該当する行を表示した後「最初のページに戻りますか?」のメッセージが表示
    3)[はい]→「来店記録」に戻ってマクロを終了。
      [いいえ]→「顧客名簿」の該当する行を表示したままマクロを終了する。

    店頭だけではなく名寄せするときにもこのマクロは大変活躍しています。
    今まで名前でしか同姓同名かどうか判断していなかったのが、メールでも電話番号でもできるようになり本当に便利です。
    何度もお手数をおかけして申し訳ありませんがご都合のよいときにチェックしてみていただければ幸いです。
  • id:icta
    > SALINGERさん
    以下で作っていただいたマクロなのですが、今回の「顧客名簿検索」のようにファイルを同じシートではなくて個別のファイルに分離することは可能でしょうか?
    自力で何とかしようと試みたのですが、マクロを実行した時に対象となるファイルが読み出されていなければ自動的に読み出す辺りがよくわからなくて断念しました。
    この自動的に読み出す機能は大変便利でエクセルに不慣れなスタッフには絶対必要なものです。
    ぜひともこれを取り込みたいと思います。
    質問終了後で申し訳ないのですが、新たに質問を起こすとまた一からの説明で反ってややこしくなってしまうためこの場で質問させていただきました。
    何度もお手数をおかけして申し訳ありません。ポイントは次回の新規質問のときに加算させていただきます。
    お手すきの時にお力をお借りできましたら幸いです。

    ○「通販管理」と「顧客名簿」を切り離す。
    http://q.hatena.ne.jp/1211105656
     
    ※仕様
    「通販管理.xls」の「通販管理」シートでマクロを実行した時、「顧客名簿.xls」が開かれていなければ自動的に開く。
    ・「通販管理」のデータは「通販管理.xls」ファイルの「通販管理」シートにある。
    ・「顧客名簿」のデータは「顧客名簿.xls」ファイルの「顧客名簿」シートにある。
    ・「会員管理」については元々CSVファイルのため切り離す必要はない。現状のまま。
    ・すべてのファイルは「C:\管理\」フォルダ内に保存されている。

    ○「通販管理」と「来店記録」を切り離す。
    http://q.hatena.ne.jp/1210987314

    ※仕様
    「通販管理.xls」でマクロを実行した時、「顧客名簿.xls」内の「来店記録」シートを自動的に開く。
    ・「通販管理」のデータは「通販管理.xls」ファイルの「通販管理」シートにある。
    ・「来店記録」のデータは「顧客名簿.xls」ファイルの「来店記録」シートにある。「顧客名簿.xls」は2つのシート「顧客名簿」「来店記録」を持つ。
    ・すべてのファイルは「C:\管理\」フォルダ内に保存されている。
  • id:SALINGER
    うわわわ。原因は余計なことをしたせいでした。すいません。
    画面のちらつきを押さえるために処理がすべて終わってから画面描画を行うようにしたんです。
    そのせいで顧客名簿がアクティブになってなかったってことでした。
    修正しておきます。
  • id:icta
    > SALINGERさん
    早々の修正ありがとうございました。
    早速新しいコードで試してみたのですが、「顧客名簿」の名前列最終行でマクロを実行した時に、スクロールがおかしな動作をするようです。
    「検索キーワード「XXX」に該当する○行を表示しました。」というメッセージが表示されますが選択した検索キーワードのみが1番上に表示され該当する行は一切表示されません。
    [いいえ」を選択してから、スクロールを上に上げると先ほどまで隠れていた行が表示されます。
    もしかしたら仕様なのかもしれませんが、最初のようにマクロを実行した時に目で該当する行を確認できた方が便利のように思います。
    また表示された行をすべて選択しているため、[メニュー]データ>フィルタ>すべて表示でフィルタを解除したとき検索キーワードに戻らず、もし10行表示されたら該当する行の中の1番目が選択されてしまいます。
    続けて検索を行うことが多いのでこれだと少し不便に感じます。
    ここも最初のように検索キーワードのみを選択した状態に戻ると便利に思います。
    オートフィルタを常に表示させるのはコード上に何か無理があるのでしょうか。
  • id:SALINGER
    Application.ScreenUpdating = False
    Application.ScreenUpdating = True
    の2行を削除すればいいみたいです。
    前の修正で、Trueにするタイミングを変えたんですが、無くしたほうがいいようです。
    これは、書き込みたびに描画されるのを一旦止めて、後でまとめて描画するコードでして、
    高速になり画面のちらつきを無くす効果があります。
    使うタイミングが適切じゃなかったようで、先の修正の原因にもなりました。
  • id:SALINGER
    顧客名簿から検索した場合、検索セルだけを選択するように変更しました。
    メニューのすべて表示の場合一番上からの表示になるのはExcelの仕様なのでどうしようもありません。
    ですが、検索セルは選択されているので矢印をどれか一つ押すことで検索セルまで移動してくれます。
  • id:icta
    この質問は
    http://q.hatena.ne.jp/1210836514
    http://q.hatena.ne.jp/1210860623
    http://q.hatena.ne.jp/1210901281
    http://q.hatena.ne.jp/1210987314
    http://q.hatena.ne.jp/1211105656
    http://q.hatena.ne.jp/1211716499
    の派生質問です。


    ■仕様
    ○ワークシートは以下のように分離

    ・「通販管理」シート
     「通販管理.xls」----「通販管理」シート
     
    ・「顧客名簿」シートと「来店記録」シート
     「顧客管理.xls」--+--「顧客名簿」シート
              +--「来店記録」シート
     
    ・「商品リスト」シート
     「商品管理.xls」----「商品管理」シート

    ○すべてのファイルは「C:\管理」フォルダ内に保存されている。

    ○ブックは以下の回答2のようにマクロ内にパス、ブック名、ワークシートを設定する。
    ブックが開いているかどうかを最初にチェックし、開いていなければマクロで開く。
    http://q.hatena.ne.jp/1211716499


    ■分離するマクロ

    1)http://q.hatena.ne.jp/1211105656
     「通販管理」から顧客情報を「顧客名簿」に転記

     ▼こちらに作成していただいたものがあります。
     この中で「通販管理」→「顧客名簿」のみブックに分離したいと思います。
     「会員管理」→「顧客名簿」は分離の必要はありません。
     http://d.hatena.ne.jp/SALINGER/20080520

     マクロは「通販管理」シートで実行します。

    ※使用するシート
    ・「通販管理.xls」の「通販管理」シート
    ・「顧客管理.xls」の「顧客名簿」シート

    2)http://q.hatena.ne.jp/1210987314
     「通販管理」から購入履歴を「来店記録」に転記

     マクロは「通販管理」シートで実行します。

     ※使用するシート
    ・「通販管理.xls」の「通販管理」シート
    ・「顧客管理.xls」の「来店記録」シート

    3)http://q.hatena.ne.jp/1210860623
     「商品管理」から「来店記録」に商品名を転記

     マクロは「来店記録」シートで実行します。
     
     ※使用するシート
    ・「商品管理.xls」の「商品管理」シート
    ・「顧客管理.xls」の「来店記録」シート


    > SALINGERさん
    マクロの修正ありがとうございました。
    何度もお手数をおかけして申し訳ありませんでした。
    昨日1日使ってみましたが、おかしな動作などは生じませんでした。
    完全に期待通りの動作でとても使いやすいです。
    最後までおつきあいいただき大変感謝しております。
    ▼以下は以前ご回答いただいたマクロを今回の顧客名簿検索のようにシートをブックに分離するための質問です。
    やはりすでに質問を締め切ったため新たな質問として投稿することにいたしました。
    お時間の許す時にご覧いただければ幸いです。
    http://q.hatena.ne.jp/1212804845

この質問への反応(ブックマークコメント)

トラックバック

  • 2008-05-31 SALINGERの日記 2008-05-31 21:42:46
    全て作業列を使うパターンです。 顧客名簿に全角でも半角でも処理できるようになっています。 Sub MacroClientSearch() ’顧客名簿のパスを環境に合わせてください Const myPath As String = &#34;C:¥Doc
  • 仕様を考える question:1211716499 個人情報の取り扱いは やっかいだ。 いや法律関係ではなく、データとしての扱い。 住所、電話番号、名前など一律的な内容ではないからだ。 また、住所を管
「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません