はじめまして、ゴールデンウィーク中にVBAを勉強していますが、上手くいきません。内容は、「UserForm1を使って別シートにあるデーターから検索を行い、ListBox1に抽出されたリストを選択すると個別のTextBox2に関連する詳細を表示させる」というものです。別シートには「顧客データ」があり、A列より「担当、氏名、カタナカ、住所、電話番号・・・」とデーターが並んでいます。中途半端な状態ですが、これ以上進めません。だれか助けてください。
Private Sub CommandButton1_Click()
Dim Namae As String
Dim MeNamae As Object
Dim ken As String
Namae = TextBox1.Text
Set MeNamae = UserForm1
Call 検索(Namae, MeNamae)
End Sub
'受付画面に検索画面窓を出し、顧客データから検索した結果を出すマクロ
Public Sub 検索(ByVal Namae As String, ByRef MeNamae As Object)
Dim Nagasa As Integer
Dim i As Long
Dim MaxRows As Long
Dim kensaku As Object
Dim KensakuChar As String
Dim ListNamae As String
Dim ListChar As String
Dim KBanme As Integer
Dim LBanme As Integer
Set kensaku = Worksheets("顧客データ")
MaxRows = kensaku.UsedRange.Rows.Count
Nagasa = Len(Namae)
MeNamae.ListBox1.Clear
For i = 3 To MaxRows
ListNamae = kensaku.Cells(i, 3)
KBanme = 0
LBanme = 0
Do
Do While Nagasa >= KBanme
KBanme = KBanme + 1
KensakuChar = Mid(Namae, KBanme, 1)
If KensakuChar <> " " Then
Exit Do
End If
Loop
Do While Nagasa >= LBanme
LBanme = LBanme + 1
ListChar = Mid(ListNamae, LBanme, 1)
If ListChar <> " " Then
Exit Do
End If
Loop
If KensakuChar = ListChar Then
If Nagasa = KBanme Then
With MeNamae
.ListBox1.AddItem (ListNamae)
End With
End If
Else
Exit Do
End If
Loop Until Nagasa <= KBanme
Next
End Sub
Private Sub ListBox1_Click()
With ListBox1
If .ListIndex > -1 Then
TextBox2.Value = .List(.ListIndex, 0)’←これでは何の意味も無い
' TextBox2.Value = kensaku.Cells(kensakuIndex, 3)
' TextBox2.Value = kensaku.Cells(kensaku, 3)
' TextBox2.Text = kokyaku.Hoken4
' TextBox2.Text = kokyaku.Cells(i, 5)
End If
End With
End Sub
No.1ベストアンサー
- 回答日時:
こんな方法はどうでしょうか?
見つけた名前をリストに追加する時に、その行も記録します。
.ListBox1.AddItem (ListNamae)
の次の行に
.ListBox1.List(.ListBox1.ListCount - 1, 1) = i
を追加します。
これで、名前リストを見つけた行も記録します。
List()の引数は0から始まるので.ListBox1.ListCount-1に記録します。
プロパティウインドウでTextBox2のMultiLineをTrueにして、ListBox1_Click()の部分を以下にしてみてください。
Private Sub ListBox1_Click()
Dim r As Long
With ListBox1
If .ListIndex > -1 Then
r = .List(.ListIndex, 1) '選択した名前の行
TextBox2.Value = Worksheets("顧客データ").Cells(r, 4) & vbCrLf & Worksheets("顧客データ").Cells(r, 5)
End If
End With
End Sub
p.s.
Dim MeNamae As Object
Dim kensaku As Object
Public Sub 検索(ByVal Namae As String, ByRef MeNamae As Object)
の、As Objectは、できるだけ避けた方がいいと思います。
Dim MeNamae As UserForm
Dim kensaku As Worksheet
Public Sub 検索(ByVal Namae As String, ByRef MeNamae As UserForm)
にすれば、VBEの入力支援機能が機能して、入力が楽になり、エラーも見つけやすくなると思います。
この回答への補足
早速のお返事とても感謝いたしております。
記述を以下のように変更いたしましたが、「TextBox2」に表示もされずまた、終了もされません。まだ何か間違いなどありますでしょうか?
大変お手数ですが、再度お返事よろしくお願い致します。
Private Sub CommandButton1_Click()
Dim Namae As String
Dim MeNamae As UserForm
Dim ken As String
Namae = TextBox1.Text
Set MeNamae = UserForm1
Call 検索(Namae, MeNamae)
End Sub
Public Sub 検索(ByVal Namae As String, ByRef MeNamae As UserForm)
Dim Nagasa As Integer
Dim i As Long
Dim MaxRows As Long
Dim kensaku As Worksheet
Dim KensakuChar As String
Dim ListNamae As String
Dim ListChar As String
Dim KBanme As Integer
Dim LBanme As Integer
Set kensaku = Worksheets("顧客データ")
MaxRows = kensaku.UsedRange.Rows.Count
Nagasa = Len(Namae)
MeNamae.ListBox1.Clear
For i = 3 To MaxRows
ListNamae = kensaku.Cells(i, 3)
KBanme = 0
LBanme = 0
Do
Do While Nagasa >= KBanme
KBanme = KBanme + 1
KensakuChar = Mid(Namae, KBanme, 1)
If KensakuChar <> " " Then
Exit Do
End If
Loop
Do While Nagasa >= LBanme
LBanme = LBanme + 1
ListChar = Mid(ListNamae, LBanme, 1)
If ListChar <> " " Then
Exit Do
End If
Loop
If KensakuChar = ListChar Then
If Nagasa = KBanme Then
With MeNamae
.ListBox1.AddItem (ListNamae)
.ListBox1.List(.ListBox1.ListCount - 1, 1) = i
End With
End If
Else
Exit Do
End If
Loop Until Nagasa <= KBanme
Next
End Sub
Private Sub ListBox1_Click()
Dim r As Long
With ListBox1
If .ListIndex > -1 Then
r = .List(.ListIndex, 1) '選択した名前の行
TextBox2.Value = Worksheets("顧客データ").Cells(r, 4) & vbCrLf & Worksheets("顧客データ").Cells(r, 5)
End If
End With
End Sub
こちらの手違いでした。動作は完璧です。まさに理想通りにうごきました。動かないと思っていたのはテキストボックスが小さかった為見えなかったからでした。大変失礼いたしました。すみませんでした。また、大変感謝いたしております。
No.2
- 回答日時:
もう判ったようだが、折角やってみたので載せておく。
自分の作ったコードのコピーを貼り付けて、読者に読み解かせるのでなく
下記のような解説が必要と思う。
ーー
顧客データシート
担当会社所在地業種年商
係A山田産業喜多町衣類販売20
係B小池商事本町食料品卸35
課長北野新宿町紙製品15
係C近藤組諏訪町建設解体10
係A北村機械北公園輸送機械25
課長南塗料新町塗料卸8
係B島田製菓八幡町菓子製造15
係A北モータス学園町クルマ修理7
係A西食品本郷食品加工25
ーーーー
(道具だて)
UserForm1を1つ挿入する。
その上のコントロールは
検索語を入力用ーーーテキストボックス
選択用アイテム表示ーリストボックス
検索開始のトリガーーコマンドボタン
リストボックス選択後の内容表示用ーーテキストボックス3つ
ーーーー
(処理の流れ)
textBox1に検索語を入れる
コマンドボタンクリック
顧客データシート検索
候補リストをリストボックスのアイテムとして表示
リストボックスにリストから選択
決定内容(顧客データ)の特定の行の項目をテキスト
ボックスに表示
ーーー
(コード)
標準モジュールに
Public gyo(10)
を入れる
ーーー
リストボックスの選択の前まで
Private Sub CommandButton1_Click()
Dim Namae As String
Dim MeNamae As Object
Dim ken As String
Namae = TextBox1.Text
Set MeNamae = UserForm1
Call 検索(Namae, MeNamae)
End Sub
'---
Public Sub 検索(ByVal Namae As String, ByRef MeNamae As Object)
Dim Nagasa As Integer
Dim i As Long
Dim MaxRows As Long
Dim kensaku As Worksheet
Dim KensakuChar As String
Dim ListNamae As String
Dim ListChar As String
Dim KBanme As Integer
Dim LBanme As Integer
Set kensaku = Worksheets("顧客データ")
MaxRows = kensaku.UsedRange.Rows.Count
Nagasa = Len(Namae)
MsgBox MaxRows
MeNamae.ListBox1.Clear
j = 0
For i = 2 To MaxRows + 1
If kensaku.Cells(i, "A") = Namae Then
With MeNamae.ListBox1
.AddItem
.List(j, 0) = kensaku.Cells(i, "B")
.List(j, 1) = kensaku.Cells(i, "C")
' & kensaku.Cells(i, "B") & kensaku.Cells(i, "C")
j = j + 1
End With
End If
Next i
End Sub
ーーー
選択後の詳細データ表示は
(1)再検索法
(2)Public変数に保持法
(3)ListBoxの列に保持法
(4)配列データ引数引渡し
など考えられるが、本件は(2)でやった。
ーー
Private Sub ListBox1_Click()
Set kensaku = Worksheets("顧客データ")
With ListBox1
If .ListIndex > -1 Then
x = ListBox1.ListIndex
'MsgBox x
MsgBox gyo(x + 1)
TextBox2.Value = .List(.ListIndex, 0)
TextBox3.Value = .List(.ListIndex, 1)
TextBox4.Value = kensaku.Cells(gyo(x + 1), 4)
TextBox5.Value = kensaku.Cells(gyo(x + 1), 5)
End If
End With
End Sub
ーーー
(操作例)
テキストに「係A」と入力
リストボックスに
山田産業
北村機機械
北モータース
西食品
が出る
例えば北村機械をクリックすると、各テキストボックスに
北村機械
北公園
輸送機械
25
が出る。
親切な回答ありがとうございます。詳しければ詳しいほど初心者である私には今後につなげることができます。これからも詳しい回答を期待しております。この度はありがとうございました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) いつもお世話になっております、VBAで教えて頂きたいのですが 2 2022/05/05 22:20
- Visual Basic(VBA) Excelで下記のようにマクロを作ったところ、一回目は実行できたのですが、二回目以降「実行時エラー1 1 2022/03/25 08:08
- Excel(エクセル) VBAについて 3 2022/06/19 18:19
- Visual Basic(VBA) VBAが止まります。 3 2022/08/31 14:09
- Visual Basic(VBA) VBA Userformで一部別シートに転記がしたいのですが 2 2023/05/24 13:08
- Visual Basic(VBA) 別シートから年齢別の件数をカウントしたいの続き 5 2023/01/24 00:16
- Visual Basic(VBA) VBAでoutlook365が起動しません。 4 2022/08/25 13:31
- Excel(エクセル) VBAの指示の内容 昨日こちらでご教示頂いたのですが初心者な為、一つ一つの指示が何をやっているのかわ 2 2022/10/25 18:08
- Visual Basic(VBA) VBA処理追加 こちらでご教示頂いたのですが回答完了させてしまいましたのでこちらからまた質問させてく 2 2022/10/27 09:57
- Visual Basic(VBA) ユーザーフォーム「frm_基本❶」を立ち上げると新規で入力する行数を右下のNoとして表示しています。 1 2023/03/16 19:02
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
access vba 『○○件づつ表示』を...
-
MSFlexGrid 行選択状態
-
C# DataTableに最後に追加した...
-
VB webデータの取得
-
VBAでアクセスDBからデータの取...
-
COBOL数値転記の仕様
-
【C#】textBoxの指定行のデータ...
-
エクセルのセル最終行取得
-
VB2010で、選択した系列を最前...
-
DataGridの全行編集状態での行追加
-
「Nullの使い方が不正です」の...
-
【VB.NET】Excelの最終行までの...
-
アクセスでウェブ上のデータを...
-
batでレジストリキーから読み取...
-
webからの帳票表示
-
エクセルのCSV読み込みについて
-
Visual Basic 2010で方形波(矩...
-
XMLでデータとして画像を指定す...
-
EXCEL VBAで散布図の作成
-
Web画面のTableから数字を取得...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
「Nullの使い方が不正です」の...
-
【C#】textBoxの指定行のデータ...
-
【VB.NET】Excelの最終行までの...
-
VBAでアクセスDBからデータの取...
-
Excel VBAでフォルダ内の全テキ...
-
C# DataTableに最後に追加した...
-
XMLでデータとして画像を指定す...
-
VBAコンボボックスの内容が反映...
-
MSFlexGrid 行選択状態
-
COBOL数値転記の仕様
-
クリスタルレポートでレコード...
-
非同期のプロセス間通信(パイプ...
-
ActiveReportのdetailをデータ...
-
アクセスでウェブ上のデータを...
-
Excel VBAでグループ毎に集計す...
-
batでレジストリキーから読み取...
-
富士通(汎用機)のAIMについて
-
Web画面のTableから数字を取得...
-
Excel VBAで1週間毎にカテゴリ...
-
エクセルのCSV読み込みについて
おすすめ情報