Wクリックで一覧表から検索するには

質問

お世話になります。
メインフォームに記載されている品名の一部と、品名の一覧表に記載されている
品名の一部が類似しているものを色付きにしたいのです。

メインフォームには、下記のような品名が記載されております。
キャラクターA　クッション
キャラクターB 　ぬいぐるみ
キャラクターC 　バッグ
　　　　：
※キャラクターの所には、実際のキャラクターが入力されております。

品名の一覧表には、
品名　サイズ　種類　年齢　カテゴリが記載されております。

やりたいこととしては、メインフォームの品名の所をWクリックすると、
品名の一覧表で同じキャラクター名の行が色付きで表示されるように
したいのです。
例
メインフォーム:品名がキャラクターA ぬいぐるみなら、
一覧表の中でキャラクターAの部分が色付きで表示するようにしたいのです。

これらを実施可能にするには、どのように仕掛けを作れで良いのでしょうか

お忙しいとは思いますが宜しくお願い致します。

回答No.3

piroin654 · ベストアンサー

いろいろと考えてみましたが、

＞メインフォームの品名の所をWクリックすると、
＞品名の一覧表で同じキャラクター名の行が色付きで表示されるように
＞したいのです。

ということであれば、単にテーブルを昇順にソートして比較すれば
一目瞭然ではないか、とか。
あるいはテーブルをHTML形式で保存し。いずれかのブラウザでひらいて
たとえばFireFoxならば検索で色表示できますし。

そのようなことで、こういったものは最終目的が何であるか明確にして
作らないと実際に作ってみても質問の内容では単なる遊びに
過ぎないもの、あるいは自己満足のものになります。
一応、質問の内容に沿ったものにしてみましたが、

＞一覧表の中でキャラクターAの部分が色付きで表示するようにしたい

というのは、キャラクターAの部分が分かり切っているならばこのような
矛盾した質問は出てこないと思いますし、最悪の場合データにいらないものを
埋め込んだりすることになるので、品名に色をつけることにしました。

コードは少し量があるので、あまり説明はしません。

準備
T品名一覧（一応、このようなテーブル名にしておきます。）に一つ
フィールドを追加います。
　　検索キー　　　テキスト型
この「検索キー」のプロパティで「Null値の許可」を「はい」に
しておきます。

（１）
以下を標準モジュールに貼り付けます。

Public varToken
Public varKeyToken

Sub funcGetToken(ByVal str1 As Variant, ByVal str2 As Variant)
　　Dim myLen As Long
　　Dim i As Long
　　Dim j As Long
　　Dim k As Long

　　myLen = Len(str1)

　　j = 0
　　k = 0

　　For i = 1 To myLen
　　　　If Left(str1, i) = Left(str2, i) Then
　　　　　　If i > 1 Then
　　　　　　　　If i = InStr(i - 1, Left(str1, i), " ") Then
　　　　　　　　　　k = k + 1
　　　　　　　　End If
　　　　　　End If
　　　　　　j = j + 1
　　　　End If
　　Next i

　　If j > 1 And k >= 1 Then
　　　　varKeyToken = Left(str1, j)
　　　　If varToken = "" Then
　　　　　　varToken = Left(str1, j)
　　　　End If
　　　　If Len(varToken) > Len(Left(str1, j)) Then
　　　　　　varToken = Left(str1, j)
　　　　End If
　　End If
End Sub

（2）
以下は、フォームのコマンドボタンのクリック時のイベントにします。
ボタンが４っつあります。
尚、DAOを使いますので参照設定でDAOにチェックがはいっているか
確認してください。
尚、「tx検索品名」というのは、対象となる品名が入力されている
テキストボックスです。実際に合わせて変更してください。
また、「埋め込み0」というのは、サブフォームを表示している
コントロール名で、サブフォームそのものの名前ではありません。
サブフォーム名と同じにしている場合もありますが、プロパティで
「ソースオブジェクト」を確認してください。

Private Sub cmd検索_Click()
　　Dim db As DAO.Database
　　Dim rs As DAO.Recordset
　　Dim strText As Variant
　　Dim strSQL As String

　　If IsNull(Me!tx検索品名) Then
　　　　MsgBox "検索対象の品名が入力されていません。"
　　　　Exit Sub
　　End If

　　strSQL = "UPDATE T品名一覧 SET T品名一覧.判定キー = Null;"

　　DoCmd.SetWarnings False
　　　　DoCmd.RunSQL strSQL
　　DoCmd.SetWarnings True

　　varToken = ""
　　Me.埋め込み0.Form.品名.FormatConditions.Delete

　　Set db = CurrentDb
　　Set rs = db.OpenRecordset("T品名一覧", dbOpenDynaset)
　　rs.Filter = Left(Me!tx検索品名, 1) = Left(rs!品名, 1)
　　'以下はレコードセットを再設定するものですがたぶん必要はないと
　　'思いますが念のために設定をコメントアウトして、おいておきます。
　　' Set rs = rs.OpenRecordset()

　　If rs.RecordCount > 0 Then
　　　　rs.MoveFirst
　　　　Do Until rs.EOF

　　　　　　varKeyToken = ""
　　　　　　Call funcGetToken(Me!tx検索品名, rs!品名)
　　　　　　rs.Edit
　　　　　　　　rs!判定キー = varKeyToken
　　　　　　rs.Update

　　　　rs.MoveNext
　　　　Loop
　　　　If varToken <> "" Then
　　　　　　With Me.埋め込み0.Form.品名.FormatConditions.Add(acExpression, , "品名 Like'" & varToken & "*'")
　　　　　　　.ForeColor = vbRed
　　　　　　End With
　　　　Else
　　　　　　MsgBox "該当するレコードはありません。"
　　　　End If
　　Else
　　　　MsgBox "該当するレコードはありません。"
　　End If

　　rs.Close: Set rs = Nothing
　　db.Close: Set db = Nothing
End Sub

Private Sub cmd書式解除_Click()
　　Me.埋め込み0.Form.品名.FormatConditions.Delete
End Sub

Private Sub cmd並べ替え解除_Click()
　　Me.埋め込み0.Form.OrderBy = "品名 ASC"
　　Me.埋め込み0.Form.OrderByOn = False
End Sub

Private Sub cmd並べ替え_Click()
　　Me.埋め込み0.Form.OrderBy = "品名 ASC"
　　Me.埋め込み0.Form.OrderByOn = True
End Sub

このてのものは、あまり作り過ぎたものを表に出すとまずいことも
あるので、このくらいがいいところでは、と思います。

お礼

お忙しい中でのご返信をありがとうございました。

私の場合、VBAが理解にいたっていないため、1つづつ検証させて
頂き、最終目的となるように頑張りたいと思っております。

また、piroin654さんの貴重な時間を割いて頂けたことを光栄に
存じております。

今回のご投稿頂きました内容を理解するまでには時間がかかると
思いますが、引き続き宜しくお願い致します。

最終結果ができましたらご報告させて頂きたいと思っております。

ありがとうございました。

回答No.4

piroin654

No3です。
訂正と説明の追加です。

準備のところの追加フィールドの名前を「検索キー」としましたが、
「判定キー」にしておいてください。コード中に「判定キー」しているので
テーブルのほうを「判定キー」とします。

この「判定キー」には、個別のレコードの「品名」を似たものと判定した
文字列を格納します。
最終的には、この個別に取り出す「判定キー」の中で最小の文字列で
前方一致する品名を取り出します。本来は必要ないものですが、一応
個別の判定がそうなっているかをみるために入れています。
したがって、cmd検索3_Clickのところで、

　　　　　　rs.Edit
　　　　　　　　rs!判定キー = varKeyToken
　　　　　　rs.Update

をコメントアウトしてデータがテーブルに入らないようにしても結果は
同じです。

回答No.2

imogasi

補足していただいたので、下記を参考までに記してみます。
多分アクセスVBAのスキルが必要だと思う。回答者の補足の様子からこの先困難を伴うのでは？
だから、小生は、本件に深入りはできません。
アクセスでの回答は慣れていないのと時間がかかるので。
アクセスの問題であることは判ってます。
＝＝＝＝
手軽なので、エクセルで下記やってみました。
無駄だと思うなら、本回答は、スルーしてください。
イメージとして下記のようなことかな？
小生側の質問の内容の受け取り方に、補足を読んでも、いまだに不明点があるが。
ーー
アクセスにもSplit関数はある。
フォームやリストボックスは、アクセスでもアクセスVBAでも、普通に使われるコントロール。
ーーー
エクセルで、
Sheet1に　A1:B５
商材名 先月販売数
マグカップ 120
ソニック 150
ぬいぐるみ 80
クッション 60
ーー
Sheet2に　A1:B5
商材名
マリオ マグカップ
ソニック Ｔシャツ
プーさん ぬいぐるみ
キティちゃん クッション
ーー
ユーザーフォームUserForm１にリストボックスListBox1を張り付ける。
ListBox1のプロパティのRowSource行に、Sheet2!A1:A5を指定=入力しておく。
--
ユーザーフォームのUserForm１のListBox1のクリックイベントとして
下記を作る。
Private Sub ListBox1_Click()
’リストボックスのクリックしたアイテムを画面表示（確認のため）
MsgBox ListBox1.List(ListBox1.ListIndex)
s = ListBox1.List(ListBox1.ListIndex)
'文字列ｓをスペースで分離・分割した文字列を作る
s2 = Split(s, " ")
'最初文字列が、配列のs2(0),次の文字列が、S2(1)に入る
k = s2(1)
'Sheet1のA列で 「K」の文字列の行を見つける。
i = Range("A1:A10").Find(k).Row()
’その行のB列の「先月販売数」を表示（本架空例での話）
MsgBox Worksheets("Sheet1").Cells(i, "B")
End Sub
ユーザーフォームの画面で「Sub/ユーザーフォームの実行」をクリック。
リストボックスがユーザーフォーム上に現れて、候補一覧が出るから、その中から１つ（１行）クリック。
操作して、画面に出る内容の様子を見て、この全体の仕組みを納得してください
。
質問者の目指すべきはこのACCESS版（VBA]か）でしょう。

回答No.1

imogasi

ここは主に「エクセル」の質問が多いところです。
質問文には、エクセルを窺わせる用語が出てこないが、エクセルの、仕組みを使って、と受け取ってよいのか？
ーー
「メインフォーム」とは、エクセルで言う、「ユーザーフォーム」（エクセルではこういう）のことか。
エクセルには「サブフォーム」という仕組みはない。だから「メイン」と言わない。アクセス向け用語？
そのユーザーフォーム上には「品名」が複数（３０種ぐらいの数が上限か）表示して（されて）いて、その１つをクリックすると、（A)シート（マスターデータ的なデータシート）の内容が品物リストにある、該当行を選択するとか、（B）別のユーザーフォーム上に、検索結果の品名　サイズ　種類　年齢カテゴリなどを表示するというのか。
ーー
質問者は、エクセルVBAはできるのか？
上記のようなことを考えたとき、イベントという仕組みをつあうことになると思うがご存じ？。
質問のし振り・表現状況からすると、VBAの経験はないだろうと思う。
すると本件実現には、事前に勉強が必要で、すぐには少し無理がある
ーー
検索が得意なのは、アクセス（ソフト）」の方が得意＝適切なので、アクセスを勉強したらどうかな。VBAが望ましいが、操作レベルでも。
ーー
＞品名の一部が類似しているもの
は、読者の理解のために、具体例を５例程度上げることを勧める。
質問文が、（エクセル向けに）はっきり書けて無くて、わかりにくい。
このデータの一部の検索も、学習事項としては難しいものと思う
ワイルドカード、Lile演算子やさらに「正規表現」などを勉強シしなくてはならないかもしれない。
ーー
検索って、プロの領域にも入り込む場合もある、難しい場合もあると思う。
ことわざの「蛇におじず」で、こんな質問のことを考えてないか？
ーー
またブルクリックでなくてクリックでもよいのだろう？

補足

ご指摘をありがとうございます。

肝心なソフトが何なのかを指定していませんでした。
申し訳ありませんでした。

ソフト:ACCESS2010
OS:Windows7
になります。可能なら、VBAのイベントやコードを教えて頂けると幸い
です。(Office系ソフトなので、ここで良いと思っておりましたが、別が
良いのであれば、教えて頂けないでしょうか)

>VBAの理解について、他者が作ったものをコピペにて利用させて頂いております。ただ、全てがわかっていないため、実際に動作させ、動きを観察しながら自分なりの変更をして使わせて頂いております。エクセルの方も
同様です。
>品名について(必ず、キャラクター名と商材の間には、半角か全角の空白が入ります。ただ、キャラクター名の途中でも入ることがあるため、最初の空白と言う関数は使えないのです)　
マリオ　マグカップVer.1
ソニック　TシャツVol.1
プーさん　ぬいぐるみ
キティちゃん　クッション
くろねこ　フィギュア
※品名は、大体、こんな仕様です。

動作:
フォームの品名の欄に上記のような品名が入力されていて、品名一覧(他のデータをフォームのデータシートビューで表示)を表示させておきます。フォームの方の品名をWクリックすることで、そこに記載されている品名に
似ているキャラ名を一覧表から見つけたいのです。(見つける時は、色で表示させたい)

言葉足らずにて申し訳ありませんでした。

引き続き宜しくお願い致します。