| |
▼こなつ さん：
こんにちは。
ADOを使った一例です。
アクセスが無くても大丈夫です。
参照設定 Microsoft Activex Data Objects x.x Library
UserFormにComboBox1とComboBox2を張付けてください。
ComboBox1のデータはB01かB02を選択して下さい。
その他の場合は抽出データがありませんので
テストデータは下記の2ファイルです。
Combo1.csv Combo2.csv
_______________ ______________
AAA BBB AAA BBB
A01 B01 B01 C01
A01 B02 B01 C02
A01 B03 B01 C03
A01 B04 B01 C04
A01 B05 B01 C05
A01 B06 B01 C06
A01 B07 B01 C07
A01 B08 B01 C08
A01 B09 B01 C09
A01 B10 B01 C10
A01 B11 B01 C11
A01 B12 B01 C12
A01 B13 B01 C13
A01 B14 B01 C14
A01 B15 B01 C15
A02 B16 B02 C16
A02 B17 B02 C17
A02 B18 B02 C18
A02 B19 B02 C19
A02 B20 B02 C20
A02 B21 B02 C21
A02 B22 B02 C22
A02 B23 B02 C23
A02 B24 B02 C24
A02 B25 B02 C25
A02 B26 B02 C26
A02 B27 B02 C27
A02 B28 B02 C28
A02 B29 B02 C29
A02 B30 B02 C30
A02 B31 B02 C31
A02 B32 B02 C32
A02 B33 B02 C33
A02 B34 B02 C34
A02 B35 B02 C35
A02 B36 B02 C36
ユーザーフォームのモジュールに
下記を張付けて見てください。
Option Explicit
Private Sub ComboBox1_Change()
Dim strFnm As String
Dim strDir As String
Dim strF As String
Dim strField As String
If Me.ComboBox1.Text = "" Then Exit Sub
strFnm = "Combo2.csv"
strField = "AAA "
strF = Me.ComboBox1.Text
With Me.ComboBox2
.ColumnCount = 2
.ColumnWidths = "30 pt;30 pt"
.BoundColumn = 2
.TextColumn = 2
.List = DataSet(strFnm, strField, strF)
End With
End Sub
Private Sub UserForm_Initialize()
Dim strFnm As String
Dim strDir As String
Dim strF As String
Dim strField As String
strFnm = "Combo1.csv"
strField = "AAA "
strF = "A01"
With Me.ComboBox1
.ColumnCount = 2
.ColumnWidths = "30 pt;30 pt"
.BoundColumn = 2
.TextColumn = 2
.List = DataSet(strFnm, strField, strF)
End With
End Sub
Private Function DataSet(strFnm As String, strField As String, strF As String) As Variant
Dim strSQL As String
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Dim i As Long
Dim strDir As String
Dim v As Variant
Dim vd As Variant
strDir = "D:\Excel\Test10\"
Set cn = New ADODB.Connection
cn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strDir & ";" & _
"Extended Properties=Text;"
cn.Open
strSQL = "SELECT * FROM " & strFnm & " " & _
"WHERE " & strField & " = '" & strF & "'"
Set rs = New ADODB.Recordset
With rs
.ActiveConnection = cn
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockOptimistic
.Source = strSQL
.Open Options:=adCmdText
End With
If Not rs.EOF Then
v = rs.GetRows
End If
rs.Close
cn.Close
If IsArray(v) Then
ReDim vd(UBound(v, 2), UBound(v))
For i = LBound(v, 2) To UBound(v, 2)
vd(i, 0) = v(0, i)
vd(i, 1) = v(1, i)
Next
End If
DataSet = vd
End Function
|
|
Yuki
- 12/1/13(金) 21:39 -
