プロが教える店舗&オフィスのセキュリティ対策術

VBA初心者です。検索フォームでうまくいきません。分かる方、コードを教えていただけませんでしょうか?
sheet1の「A列に顧客名」、「B列にフリガナ」、「C列に住所」、「D列に電話番号」、「E列に区分」「F列に備考」があります。
ユーザーフォームより検索フォームを作成したいのですが、
①顧客名検索
②住所検索
③区分検索
どの検索も部分一致(顧客名検索なら苗字だけでもヒットする)で検索を行ない、
リスト結果には「A列顧客名」、「C列住所」、「D列電話番号」、「E列区分」を表示させるようにし、検索されたリストボックスをダブルクリックでリストボックスの下あたりに備考の詳細が表示されるようにしたいのですが、どうしてもうまくいきません。
(検索フォームには「txt顧客名検索」「txt住所検索」「txt区分検索」というふうにどの条件でも検索出来るようにテキストボックスを作成しています。)
どなたか、分かる方、教えていただけませんでしょうか。
よろしくお願いします。

質問者からの補足コメント

  • 1)現状ではこれだけの項目で作成していますが、項目数を増やす予定でいますので、リストにはA列とC列とD列などのように後々表示出来る列を変更出来ると嬉しいです。

    2)はい。リストボックスの下にテキストボックスがあり、ダブルクリックした顧客情報の備考などが表示されるようにしたいです。

    3)今後、項目数が増えた時に備考以外にも表示させたい項目が増える可能性があるので2案が希望です。

    4)検索開始はコマンドボタンの予定です。また各1つずつで検索出来れば良いので、オプションボタンで
    選択された検索ボタンだけクリック出来るように
    Enabledのtrue、falseあるのが理想です。
    ユーザーフォーム上では、横並びにそれぞれ「(顧客名検索)オプションボタン」、「(顧客名検索)テキストボックス」、 「(顧客名検索)実行ボタン」と3列並べたいです。

    よろしくお願いします。

      補足日時:2017/09/21 22:01
  • 1)現状ではこれだけの項目で作成していますが、項目数を増やす予定でいますので、リストにはA列とC列とD列などのように後々表示出来る列を変更出来ると嬉しいです。

    2)はい。リストボックスの下にテキストボックスがあり、ダブルクリックした顧客情報の備考などが表示されるようにしたいです。

    3)今後、項目数が増えた時に備考以外にも表示させたい項目が増える可能性があるので2案が希望です。

    4)検索開始はコマンドボタンの予定です。また各1つずつで検索出来れば良いので、オプションボタンで
    選択された検索ボタンだけクリック出来るように
    Enabledのtrue、falseあるのが理想です。
    ユーザーフォーム上では、横並びにそれぞれ「(顧客名検索)オプションボタン」、「(顧客名検索)テキストボックス」、 「(顧客名検索)実行ボタン」と3列並べたいです。

    よろしくお願いします。

    No.1の回答に寄せられた補足コメントです。 補足日時:2017/09/21 22:07
  • 1)タブなり|などのデリミタが欲しいです。(何度か挑戦したのですが、リストボックス内に「名前住所区分」とつながって表示されるため、とても見づらいです。

    2)当初は、上のフォームをイメージしておりましたが、下のフォームのように、
    「(顧客名検索)オプションボタン」ONの時で実行の場合は「sheet1のA列」から、
    「(住所検索)オプションボタン」ONで実行の場合は「sheet1のC列」から
    「(区分検索)オプションボタン」ONで実行の場合は「sheet1のE列」から検索という事も出来ますか?

    当初は上のフォームをイメージしておりましたが、下のフォームの方が見た目・使いやすさが良いのではと考えております。可能であれば下のフォームが希望です。
    文章の伝え方が下手ですみません。よろしくお願いいたします。

    「VBA初心者です。検索フォームについて教」の補足画像3
    No.3の回答に寄せられた補足コメントです。 補足日時:2017/09/22 10:07
  • リスト内の行番号に関して
    行番号の表示が最後列にあると個人的に見づらいので、先頭に持ってくることは可能ですか?

    現在、このようなフレームになっております。
    1.フレーム内にSheet1より呼び起こした情報を訂正などした場合に更新ボタンで反映させたい。
    2.呼び起こした顧客情報が不要な場合に削除したい。

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

    「VBA初心者です。検索フォームについて教」の補足画像4
    No.5の回答に寄せられた補足コメントです。 補足日時:2017/09/23 11:24
  • うれしい

    1.その制約で大丈夫です。

    2.リスト内の行番号は表示しないようにお願いします。

    3.
    リストボックス内の顧客名の桁数(10桁)
    リストボックス内の住所の桁数(10桁)
    リストボックス内の電話番号の桁数(半角11桁)
    リストボックス内の区分の桁数(8桁)
    整列文字を希望します。
    この整列数はコードから変更可能ですか?不可能であれば、上記数字でお願いします。

    4.フレーム内のオブジェクト名ですが
    更新ボタン=CommandButton2
    削除ボタン=CommandButton3
    顧客名=TextBox2
    ・・・(途中省略)・・・
    備考=TextBox7
    で作成しますが、宜しいでしょうか。   大丈夫です。

    本当に親切にありがとうございます。
    よろしくお願いいたします。

    No.6の回答に寄せられた補足コメントです。 補足日時:2017/09/23 15:34

A 回答 (8件)

前回のは全て破棄してください。


-----------------------------------
Option Explicit
Const delm As String = vbTab
Dim rowsTbl() As Long
Dim currentRow As Long
'更新ボタン
Private Sub CommandButton1_Click()
Dim sh As Worksheet
Dim maxrow As Long
Dim row As Long
Dim col As String
Dim word As String
Dim item As String
Dim ctr As Long
Dim s1 As String
Dim s2 As String
Dim s3 As String
Dim s4 As String
col = ""
If OptionButton1.Value = True Then
col = "A" '顧客名で検索
End If
If OptionButton2.Value = True Then
col = "C" '住所で検索
End If
If OptionButton3.Value = True Then
col = "E" '住所で検索
End If
If col = "" Then
MsgBox ("検索項目未設定")
Exit Sub
End If
If TextBox1.Value = "" Then
MsgBox ("検索データ未設定")
Exit Sub
End If
Set sh = Worksheets("Sheet1")
maxrow = sh.Cells(sh.rows.Count, 1).End(xlUp).row
ListBox1.Clear
word = TextBox1.Value
ctr = 0
For row = 2 To maxrow
If InStr(sh.Cells(row, col).Value, word) > 0 Then
s1 = just(sh.Cells(row, "A").Value, 20) & delm
s2 = just(sh.Cells(row, "C").Value, 20) & delm
s3 = just(sh.Cells(row, "D").Value, 11) & delm
s4 = just(sh.Cells(row, "E").Value, 16)
item = s1 & s2 & s3 & s4
ListBox1.AddItem item
ReDim Preserve rowsTbl(ctr)
rowsTbl(ctr) = row
ctr = ctr + 1
End If
Next
If ctr = 0 Then
MsgBox ("該当項目なし")
End If
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
TextBox5.Value = ""
TextBox6.Value = ""
TextBox7.Value = ""
End Sub
'更新ボタン
Private Sub CommandButton2_Click()
Dim row As Long
Dim sh As Worksheet
If currentRow = 0 Then
MsgBox ("更新ボタンは無効です")
Exit Sub
End If
row = currentRow
Set sh = Worksheets("Sheet1")
sh.Cells(row, "A").Value = TextBox2.Value
sh.Cells(row, "B").Value = TextBox3.Value
sh.Cells(row, "C").Value = TextBox4.Value
sh.Cells(row, "D").Value = TextBox5.Value
sh.Cells(row, "E").Value = TextBox6.Value
sh.Cells(row, "F").Value = TextBox7.Value
ListBox1.Clear
currentRow = 0
MsgBox ("更新完了")
End Sub
'削除ボタン
Private Sub CommandButton3_Click()
If currentRow = 0 Then
MsgBox ("削除ボタンは無効です")
Exit Sub
End If
Worksheets("Sheet1").rows(currentRow).Delete
ListBox1.Clear
currentRow = 0
MsgBox ("削除完了")
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim elm() As String
Dim row As Long
Dim sh As Worksheet
If IsNull(ListBox1.Value) = True Then Exit Sub
If ListBox1.Value = "" Then Exit Sub
row = rowsTbl(ListBox1.ListIndex)
Set sh = Worksheets("Sheet1")
TextBox2.Value = sh.Cells(row, "A").Value
TextBox3.Value = sh.Cells(row, "B").Value
TextBox4.Value = sh.Cells(row, "C").Value
TextBox5.Value = sh.Cells(row, "D").Value
TextBox6.Value = sh.Cells(row, "E").Value
TextBox7.Value = sh.Cells(row, "F").Value
currentRow = row
End Sub
Private Function just(ByVal str As String, ByVal max As Long) As String
Dim sa As Long
just = MaxStr(str, max)
sa = max - LenMbcs(just)
If sa <= 0 Then Exit Function
just = just & Space(sa)
End Function
Function LenMbcs(ByVal str As String)
LenMbcs = LenB(StrConv(str, vbFromUnicode))
End Function

Private Function MaxStr(ByVal str As String, ByVal max As Long) As String
Dim size As Long
Dim sum As Long
Dim i As Long
Dim c As Variant
size = Len(str)
sum = 0
MaxStr = ""
For i = 1 To size
c = Mid(str, i, 1)
If LenMbcs(c) + sum > max Then Exit Function
MaxStr = MaxStr & c
sum = sum + LenMbcs(c)
Next
End Function
------------------------------------------------
リストボックス変更例:
顧客名を12桁にする場合は
s1 = just(sh.Cells(row, "A").Value, 24) & delm
のようにします。(数字は半角換算の値)
フォントをMSゴシックにしてください。
    • good
    • 0
この回答へのお礼

思い描いた通りの検索フォームが完成しました。
本当にありがとうございました。
また、今後作成にあたり、分からないときはこのコーナーで質問することもありますので、
見かけた際にはお願いします。

お礼日時:2017/09/25 08:58

添付図を忘れました。


尚、その場合、リストボックスのfontはMS ゴシックにしておく必要があります。(固定幅のフォントでないと桁数がそろいません)
「VBA初心者です。検索フォームについて教」の回答画像7
    • good
    • 0

1.更新、削除をおこなった場合、リストボックスに表示されている項目との不整合が発生します。


(例えば住所を更新した場合、リスト内の住所とフレーム内の住所が不一致になります。削除した場合は、削除された顧客がリストボックス内に存在します)
そのような状況を回避する為に、以下の制約を設けますが宜しいでしょうか。
1)更新又は削除完了時には、リストボックス内に表示された内容を全てクリアする。
2)一旦、更新又は削除が行われた場合、その直後に、更新ボタン又は削除ボタンをクリックしても無効とする。
(再度、同じ顧客を更新したい場合は、検索からやり直しする)

2.リスト内の行番号ですが、あれから再検討しましたところ、行番号を表示しないようにすることが可能です。
先頭へ持ってくるのではなく、表示しないようにしますが、宜しいですか。

3.現状では、リストボックス内の各項目が整列表示されていませんが、これを添付の図のように整列表示することは可能です。
その場合は、以下の情報が必要となります。
リストボックス内の顧客名の桁数
リストボックス内の住所の桁数
リストボックス内の電話番号の桁数
リストボックス内の区分の桁数
桁数は、全角10桁、又は半角20桁のように回答してください。
全角と半角が混在する場合は、全角1桁を半角2桁に換算して回答してください。
もし、整列表示を望まれるなら、その旨回答ください。

4.フレーム内のオブジェクト名ですが
更新ボタン=CommandButton2
削除ボタン=CommandButton3
顧客名=TextBox2
・・・(途中省略)・・・
備考=TextBox7
で作成しますが、宜しいでしょうか。
この回答への補足あり
    • good
    • 0

>リストボックス内にシート1の行番号を表示させないようには出来ないでしょうか?


>&rowを消してみたけど、ダメでした。

No1の質問3)で2案を選択していますね。2案にした場合は、行番号を消すことはできません。
どうしても消すなら、備考を表示することをあきらめるしかありません。
尚、1案でやれば、行番号を表示しないようにできますが、行番号が表示されることを承知して2案を選択したのではないでしょうか。

>もう一つ、図々しいのですがお力を貸して下さい。
>リストボックス下に、フレームを配置してシート1の項目を全てを表示させるようにしたのですが、このフレーム内で書き換えたデータを>更新ボタンにて更新や、不要な顧客情報を削除などは出来るのでしょうか?

この場合も、その行番号をどこかに記憶しておけば更新することは可能です。
但し、削除の場合は、行を削除することにより、行が繰り上がるので、そのことを考慮する必要があります。
(リストボックスのなかで記憶していた行番号を再度作り直す必要があります)

どのようなフレームを作成したのかそのイメージを画像で提示していただけますか。
(更新ボタン、削除ボタンも含めて)
この回答への補足あり
    • good
    • 0

以下のようにしてください。


-------------------------------
Option Explicit
Const delm As String = vbTab
Private Sub CommandButton1_Click()
Dim sh As Worksheet
Dim maxrow As Long
Dim row As Long
Dim col As String
Dim word As String
Dim item As String
Dim ctr As Long
col = ""
If OptionButton1.Value = True Then
col = "A" '顧客名で検索
End If
If OptionButton2.Value = True Then
col = "C" '住所で検索
End If
If OptionButton3.Value = True Then
col = "E" '住所で検索
End If
If col = "" Then
MsgBox ("検索項目未設定")
Exit Sub
End If
If TextBox1.Value = "" Then
MsgBox ("検索データ未設定")
Exit Sub
End If
Set sh = Worksheets("Sheet1")
maxrow = sh.Cells(sh.Rows.Count, 1).End(xlUp).row
ListBox1.Clear
word = TextBox1.Value
ctr = 0
For row = 2 To maxrow
If InStr(sh.Cells(row, col).Value, word) > 0 Then
item = sh.Cells(row, "A").Value & delm & sh.Cells(row, "C").Value & delm & sh.Cells(row, "D").Value & delm & sh.Cells(row, "E").Value & delm & row
ListBox1.AddItem item
ctr = ctr + 1
End If
Next
If ctr = 0 Then
MsgBox ("該当項目なし")
End If
TextBox2.Value = ""
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim elm() As String
Dim row As Long
If IsNull(ListBox1.Value) = True Then Exit Sub
If ListBox1.Value = "" Then Exit Sub
elm = Split(ListBox1.Value, delm)
row = CLng(elm(UBound(elm)))
TextBox2.Value = Worksheets("Sheet1").Cells(row, "F").Value
End Sub
--------------------------------
デリミタはタブです。
これを|に変えたい場合は、2行目を
Const delm As String = "|"
などにしてください。
    • good
    • 1
この回答へのお礼

助かりました

ありがとうございます。
思い通りの検索フォームが完成しました。
リストボックス内にシート1の行番号を表示させないようには出来ないでしょうか?
&rowを消してみたけど、ダメでした。

もう一つ、図々しいのですがお力を貸して下さい。
リストボックス下に、フレームを配置してシート1の項目を全てを表示させるようにしたのですが、このフレーム内で書き換えたデータを更新ボタンにて更新や、不要な顧客情報を削除などは出来るのでしょうか?
質問ばかりですみません。

お礼日時:2017/09/22 20:17

No2です。

画像の添付を忘れましたので添付します。
「VBA初心者です。検索フォームについて教」の回答画像3
この回答への補足あり
    • good
    • 0

>1)現状ではこれだけの項目で作成していますが、項目数を増やす予定でいますので、リストにはA列とC列とD列などのように後々表示出来る列を変更出来ると嬉しいです。


最初のマクロを提示する場合は、A列、C列、D列、E列とします。後々変更する場合は、あなたの方で変更をお願いします。
(どの列を扱っているかはマクロをみればわかります)
私が確認したかったのは、A列、C列、D列、E列を単純に連結した結果をリストボックスに表示してよいのかということです。
(リストボックスには1項目しか格納できませんので、連結した結果を格納します)
そのとき、タブなり|などのデリミタがないと、見た目がおかしくなりませんかといことです。この件、回答をいただいていません。

>4)検索開始はコマンドボタンの予定です。また各1つずつで検索出来れば良いので、オプションボタンで
選択された検索ボタンだけクリック出来るように
Enabledのtrue、falseあるのが理想です。
ユーザーフォーム上では、横並びにそれぞれ「(顧客名検索)オプションボタン」、「(顧客名検索)テキストボックス」、 「(顧客名検索)実行ボタン」と3列並べたいです。

意味がよくわかりません。添付の図のように「(顧客名検索)オプションボタン」、「(顧客名検索)テキストボックス」、 「(顧客名検索)実行ボタン」と3列並べたとき、

オプションボタンがONなら顧客名で検索することは理解でますが、OFFの時は、住所検索なのか、区分検索なのかが判りません。
あなたが、考えている検索フォームを画像で提示していただけませんでしょうか。
添付の図で赤線が(顧客名検索)オプションボタン、黄色で囲んだところが(顧客名検索)テキストボックスのつもりです。
    • good
    • 0

いくつか不明点がありますので、まずそれの確認が必要になります。


1)リスト結果には「A列顧客名」、「C列住所」、「D列電話番号」、「E列区分」を表示させるとのことですが、
「A列顧客名」、「C列住所」、「D列電話番号」、「E列区分」を単純に連結した結果を表示して良いのですか。
それとも例えばタブなどを挟んで連結すれば見やすくなると思いますが、どのように考えてますか。

2)ダブルクリックで、「備考」をリストボックスの下あたりに表示したいとのことですが、意味がよくわかりません。
リストボックスの下あたりには、何かテキストボックスのようなものがありそこに表示させたいということでしょうか。

3)ダブルクリックで、「備考」を表示する場合ですが、以下の2つの案が考えられます。
1案:備考を別のリストボックス(但し非表示にしておく)に格納しておいて、そこから取り出し表示する。
2案:リストボックスにデータを格納するとき、その行番号も同時に格納し、その行番号からたどって備考を表示する。
1案のほうが見た目はきれいだが複雑、2案のほうが簡単だが、見た目が悪い。

4)「txt顧客名検索」「txt住所検索」「txt区分検索」のテキストボックスに検索文字を入力後、
検索を行うトリガとなるのは、何でしょうか。何か、コマンドボタンを用意しておいて、それがクリックされた時、
検索を開始すると理解してよいですか。
もし、その場合、「txt顧客名検索」「txt住所検索」「txt区分検索」の全てに検索文字があれば、どのように検索すれば
よいのですか。
1案:「txt顧客名検索」「txt住所検索」「txt区分検索」で優先順位をきめてその順で検索する。
2案:「txt顧客名検索」「txt住所検索」「txt区分検索」で全て検索し、AND条件で成立したものをリストボックスへ格納。
3案:「txt顧客名検索」「txt住所検索」「txt区分検索」で全て検索し、OR条件で成立したものをリストボックスへ格納。
などが考えられます。

上記について、どのように考えてますか。
この回答への補足あり
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!