|
こんなのでも善いかも?
Option Explicit
'データ列数(A〜I列)
Const clngColumns As Long = 9
Private Sub ComboBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim i As Long
Dim j As Long
Dim k As Long
Dim lngRows As Long
Dim vntKey As Variant
Dim vntCopm As Variant
Dim vntData As Variant
Dim rngList As Range
'ComboBoxからKeyを取得
vntKey = "*" & Trim(Me.ComboBox1.Value) & "*"
'探索列の位置を設定(A列からの列位置、例えば、G列なら7)
vntCopm = Array(7, 8, 9)
'データListの左上隅セル位置を基準として設定(列見出しA1のセル位置)
Set rngList = Worksheets("Sheet1").Cells(1, "A")
With rngList
'データ行数を取得
lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row
'データが無い場合
If lngRows <= 0 Then
MsgBox "データが有りません", vbInformation
GoTo Wayout
End If
End With
With ListBox1
.Clear
'List全ての行に就いて繰り返し
For i = 1 To lngRows
vntData = rngList.Offset(i).Resize(, clngColumns).Value
'1行内の探索値の有無確認
For j = 0 To UBound(vntCopm)
If vntData(1, vntCopm(j)) Like vntKey Then
'ListBoxに出力
.AddItem vntData(1, 1)
For k = 2 To clngColumns
.List(.ListCount - 1, k - 1) = vntData(1, k)
Next k
End If
Next j
Next i
End With
Wayout:
Set rngList = Nothing
End Sub
Private Sub UserForm_Initialize()
'ComboBoxの設定
With ComboBox1
'Listの値を設定
.List = Array("a", "b", "c")
End With
'ListBoxの設定
With ListBox1
.ColumnCount = clngColumns
End With
End Sub
|
|