回答編集履歴

2

コードの修正

2018/03/15 13:04

投稿

hatena19
hatena19

スコア33699

test CHANGED
@@ -118,6 +118,8 @@
118
118
 
119
119
  adoRs.MoveNext
120
120
 
121
+ cnt = Cnt + 1
122
+
121
123
  Loop
122
124
 
123
125
  End With

1

サンプルコードの追加

2018/03/15 13:04

投稿

hatena19
hatena19

スコア33699

test CHANGED
@@ -31,3 +31,115 @@
31
31
 
32
32
 
33
33
  [Office TANAKA - Excel VBA Tips[複数列のリストボックス]](http://officetanaka.net/excel/vba/tips/tips158.htm)
34
+
35
+
36
+
37
+ サンプルコード
38
+
39
+ ---
40
+
41
+
42
+
43
+ 条件の詳細な仕様が不明なので、部分一致で、(姓, セイ) と (電話番号1, 電話番号2) はAND条件 と仮定してます。
44
+
45
+
46
+
47
+ ```vba
48
+
49
+ '---ユーザーを検索
50
+
51
+ Sub SearchButton_Click()
52
+
53
+ Dim strSQL As String
54
+
55
+ Dim cnt As long
56
+
57
+ ' On Error GoTo Err_Handler 'エラーが起きたら"Err_Handler"へ
58
+
59
+ Call ConnectDB 'データベースに接続
60
+
61
+
62
+
63
+ strSQL = "SELECT 顧客コード,姓,名,住所1,住所2,電話番号1,電話番号2, セイ FROM 顧客マスター"
64
+
65
+ adoRs.Open strSQL, adoCn
66
+
67
+
68
+
69
+ If adoRs.BOF And adoRs.EOF Then 'データがない場合、データベースを切断して終了
70
+
71
+ Call CutDB
72
+
73
+ MsgBox "参照先にデータがありません。"
74
+
75
+ Exit Sub
76
+
77
+ End If
78
+
79
+
80
+
81
+ '抽出条件を設定してフィルタをかける
82
+
83
+ adoRs.Filter = "姓 & メイ Like '%" & Me.TextBox1.Value & "%'" & _
84
+
85
+ " AND 電話番号1 & ";" & 電話番号2 Like '%" & Me.TextBox1.Value & "%'"
86
+
87
+ If adoRs.BOF AND adoRs.EOF Then
88
+
89
+ Call CutDB
90
+
91
+ MsgBox "条件に一致するデータがありません。"
92
+
93
+ Else
94
+
95
+ With Me.SearchList '該当したレコードをリストボックスに表示する
96
+
97
+ .ColumnCount = 7 '列数 7
98
+
99
+ .ColumnWidths = "10;30;30;100;50;50" '列幅を設定
100
+
101
+ Do Until adoRs.EOF '抽出したレコードが終了するまで繰り返す
102
+
103
+ .AddItem ""
104
+
105
+ .List(cnt,0) = adoRs(0).Value
106
+
107
+ .List(cnt,1) = adoRs(1).Value
108
+
109
+ .List(cnt,2) = adoRs(2).Value
110
+
111
+ .List(cnt,3) = adoRs(3).Value
112
+
113
+ .List(cnt,4) = adoRs(4).Value
114
+
115
+ .List(cnt,5) = adoRs(5).Value
116
+
117
+ .List(cnt,6) = adoRs(6).Value
118
+
119
+ adoRs.MoveNext
120
+
121
+ Loop
122
+
123
+ End With
124
+
125
+ End If
126
+
127
+
128
+
129
+ Call CutDB '検索がすんだら、データベースを切断して終了
130
+
131
+ Exit Sub
132
+
133
+
134
+
135
+ Err_Handler: 'エラーが起きたときの飛び先
136
+
137
+ Call CutDB
138
+
139
+ MsgBox Error$
140
+
141
+
142
+
143
+ End Sub
144
+
145
+ ```