| |
今晩は。
>>データの様子ややりたいことが漠然としていて、今のところ考えようがないです。
>>
>>もし、今までの質問と内容がことなるのなら、別スレッドで質問されたほうがいいと思いますが？。
>>1つのスレッドに対し、1問1答がまとまりがよく、望ましいです。
>Conbobox2によりSheet(A列〜K列、1〜６００行）のセルの検索結果をListboxに表示させたいのですが、無理ですか？お願いします。
Conbobox1とConbobox2とListBox1の３つが連動して関係しているときは、しっかりと仕様が決まっていないと、結局、全体として完成したものはできません。
漠然としていて、Conbobox1とConbobox2の関係がわからないので、下記の参考コードしかできません。
これで分らなかったら、しっかりと仕様を決めて、別スレッドで質問しなおしてください。
参考までに
Private dic As Object
Private Sub UserForm_Initialize()
Dim cmbList
cmbList = Array("X", "Y", "Z") 'ComboBox1に表示する値をセット
'この配列は自分で決めてください
'ComboBox1とComboBox2の関係を決めるコードをここに書く（配列を作る）
'このコードは自分で決めてください
'
ComboBox1.List = cmbList
ComboBox1.ListIndex = 0
End Sub
Private Sub ComboBox1_Change()
Dim rng As Range, r As Range, rn As Range
Dim vnt As Variant, v, cmbList
Dim dicChk As Object
Dim cmbList2
cmbList2 = Array("a", "b", "c") 'ComboBox2に表示する値をセット
'この配列はComboBox1によって変化するように
'自分で決めてください
With Sheets("Sheet1")
Set rng = .Range("A1", .Range("A65536").End(xlUp))
End With
'
Set dic = CreateObject("Scripting.Dictionary")
Set dicChk = CreateObject("Scripting.Dictionary")
'
For Each v In cmbList2
For Each rn In rng.Cells
For Each r In rn.Resize(1, 11)
If r.Text Like ("*" & v & "*") Then
If dic.exists(v) Then
If dicChk.exists(r.Row & v) Then Exit For
vnt = dic(v)
ReDim Preserve vnt(UBound(vnt) + 1)
vnt(UBound(vnt)) = Cells(r.Row, 1).Resize(1, 11).Value
Else
ReDim vnt(0 To 0)
vnt(0) = Cells(r.Row, 1).Resize(1, 11).Value
End If
dic(v) = vnt
dicChk(r.Row & v) = ""
End If
Next
Next
Next
'
ListBox1.ColumnCount = 11 'ListBox1を11列表示にする
'
Set dicChk = Nothing
Set rng = Nothing
ComboBox2.List = cmbList2
ComboBox2.ListIndex = 0
End Sub
Private Sub ComboBox2_Change()
ListBox1.List = Application.Transpose(Application. _
Transpose(dic(ComboBox2.Value)))
End Sub
Private Sub UserForm_Terminate()
Set dic = Nothing
End Sub
|
|
太公望
- 06/3/7(火) 23:54 -
