vbaのclassモジュールを呼び出し

質問

現在フォームに書いてるcode
ーーー
’シート１のB列250件くらい有る(名前)→コンボボックスに漢字１−２文字入れて表示件数を絞り込み→comboboxにリスト表示している。
ーーー
ーーーーー
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim i As Integer
'押されたキーが、Enterキー以外は終了
If KeyCode <> vbKeyReturn Then Exit Sub

'テキスト部分が選択されている場合
If ComboBox1.ListIndex = -1 Then
ComboBox1.Visible = False 'コンボボックスを非表示
ComboBox1.Visible = True 'コンボボックスを表示
ComboBox1.List = Array() 'コンボボックスのリストをクリア
'値を部分一致で抽出
For i = 2 To Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row
If InStr(Sheets("Sheet1").Cells(i, "B"), ComboBox1.Text) > 0 Then
'コンボボックスのリストに追加
ComboBox1.AddItem Sheets("Sheet1").Cells(i, "B")
End If
Next
End If

KeyCode = 0 'コンボボックスをフォーカス
ComboBox1.DropDown 'リストを表示

End Sub
ーーーーー
ーーー
’上記Combobox1で表示された内容の同行＆別列で対応するセル内容をLabelに表示させたい、が「行 = 行 + 1」でエラー吐く。
ーーー
ーーーーー
Private Sub ComboBox1_Change()
Dim 行 As Integer
行 = 1
Do
行 = 行 + 1
Loop Until ComboBox1.Text = Worksheets("Sheet1").Cells(行, 2) 'ComboBox1に表示されてる文字列が、B列の何行目に記載されてるか取得
FormMain.Label1.Caption = Worksheets("Sheet1").Cells(行, 1) 'B列に記載されてる文字列と同じ行にある、A列の文字を取得してTextBox1に表示
FormMain.Label2.Caption = Worksheets("Sheet1").Cells(行, 4) 'B列に記載されてる文字列と同じ行にある、D列の文字を取得してTextBox1に表示

End Sub
ーーーーー

検索絞り込み・Labelに表示・最終行の取得(これはエラーなく動かせてる)は、Sheet2でも使うのでclassモジュールに書きたい＋formでの呼び出しがうまく行かない。
インターネットで調べながら組み合わせたが自力解決出来なかったのでよろしくお願いします(Vbaの知識は無し)。
元データーは現在Accessで動いてますが、B列(名前250件くらい)ComboBoxで全件読み込みから目当ての名前１つを探し出す宝探し状態。
元データー制作は10年くらい前に業者発注した物(当時は250件を想定してなかったのだろう)→現在は連絡取れない方なのです。
Vba(ComboBox絞り込み)での作り直しを希望してます。

回答No.11

kkkkkm · ベストアンサー

> combobox番号:sheet2の１列目参照とsheet2の４列目参照
> combobox2:label4と５
> combobox３:label6と7

のようにしたいのでしたら
(以下はご自身の環境に合わせて変更してください)

FormMainTestに
ComboBox1、ComboBox2、Label1、Label2、Label3、Label4
があるとして

クラスを使う場合

ComboBox1はSheet1のlabel1と2　対象
ComboBox2はSheet2のlabel3と4　対象
といった感じを例にすると

FormMainTestのモジュールに

Private mCtrl(1 To 2) As New ClassEvent

Private Sub UserForm_Initialize()
Dim i As Long

For i = 1 To 2
mCtrl(i).SetCtrl Me("Combobox" & i), Sheets("Sheet" & i), i * 2 - 1
Next
End Sub

フォームモジュールにクラスでセットするイベントは書かない。

ClassEventというクラスモジュール

Private WithEvents mTarget As MSForms.ComboBox

Dim mSheet As Worksheet
Dim LabelA As Long, LabelB As Long

Public Sub SetCtrl(New_Ctrl As MSForms.ComboBox, ByRef Sh As Worksheet, ByVal LabelNo As Long)

Set mTarget = New_Ctrl
Set mSheet = Sh
LabelA = LabelNo
LabelB = LabelNo + 1
mTarget.List = mSheet.Range("B1:B9").Value

End Sub

Private Sub mTarget_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim i As Long
'押されたキーが、Enterキー以外は終了
If KeyCode <> vbKeyReturn Then Exit Sub
'テキスト部分が選択されている場合
If mTarget.ListIndex = -1 Then
mTarget.Visible = False 'コンボボックスを非表示
mTarget.Visible = True 'コンボボックスを表示
mTarget.Clear 'コンボボックスのリストをクリア
'値を部分一致で抽出
For i = 2 To mSheet.Cells(Rows.Count, "B").End(xlUp).Row
If InStr(mSheet.Cells(i, "B"), mTarget.Text) > 0 Then
'コンボボックスのリストに追加
mTarget.AddItem mSheet.Cells(i, "B")
End If
Next
End If

KeyCode = 0
mTarget.DropDown 'リストを表示
' Application.EnableEvents = True
End Sub

Private Sub mTarget_Change()
Dim mRng As Range, fRng As Range

With mSheet
Set fRng = .Range(.Cells(1, "B"), .Cells(Rows.Count, "B").End(xlUp))
Set mRng = fRng.Find(What:=mTarget.Text, LookIn:=xlValues)
If Not mRng Is Nothing Then
FormMainTest.Controls("Label" & LabelA).Caption = .Cells(mRng.Row, 1)
FormMainTest.Controls("Label" & LabelB).Caption = .Cells(mRng.Row, 4)
End If
End With
End Sub

クラスを使わない場合は

標準モジュールに(Changeの場合)
Sub Change(引数1, 引数2, 引数3, 引数4)
'ComboBox1_Changeのコードを引数に対応するところを変数で
End Sub

フォームモジュールに
Private Sub ComboBox1_Change()
Call Change(引数1, 引数2, Label1, Label2)
End Sub

Private Sub ComboBox2_Change()
Call Change(引数1, 引数2, Label3, Label4)
End Sub

みたいな感じでいいのではないでしょうか。

補足

classの方はindexが有効範囲にありません、と却下されました。
classモジュールは使い方が難しいのですね(classモジュールは諦めたほうがよさげ・・・と感じました)。

標準モジュールの、引数はどのように書けば良いのでしょうか？
Dim i As で
http://officetanaka.net/excel/vba/tips/tips94.htm
に近いことをすれば良いのでしょうか？
詳細教えてもらえると助かります。

回答No.1

kkkkkm

Private Sub ComboBox1_Change()
の方ですが
行 = 行 + 1」でエラー吐く

Dim 行 As Integer
なので
ComboBox1に表示されてる文字列が、B列にない場合Integerを超えた時点でエラーになると思います。

> FormMain.Label1.Caption = Worksheets("Sheet1").Cells(行, 1) 'B列に記載されてる文字列と同じ行にある、A列の文字を取得してTextBox1に表示

「TextBox1に表示」とコメントしていますがコードはLabel1になっていますのでコードのまま。
(クラスにする必要があるかどうかはわかりません)

名前を Class1とした場合

Class1のクラスモジュールに

Sub SetList(ByRef mSheet As Worksheet, ByRef mForm As Object)
Dim i As Long

mForm.ComboBox1.Clear 'コンボボックスのリストをクリア
'値を部分一致で抽出
For i = 2 To mSheet.Cells(Rows.Count, "B").End(xlUp).Row
If InStr(mSheet.Cells(i, "B"), mForm.ComboBox1.Text) > 0 Then
'コンボボックスのリストに追加
mForm.ComboBox1.AddItem mSheet.Cells(i, "B")
End If
Next

End Sub

Sub SetLabel(ByRef mSheet As Worksheet, ByRef mForm As Object)
Dim mRng As Range, fRng As Range

With mSheet
Set fRng = .Range(.Cells(1, "B"), .Cells(Rows.Count, "B").End(xlUp))
Set mRng = fRng.Find(What:=mForm.ComboBox1.Text, LookIn:=xlValues)
If Not mRng Is Nothing Then
mForm.Label1.Caption = .Cells(mRng.Row, 1)
mForm.Label2.Caption = .Cells(mRng.Row, 4)
End If
End With

End Sub

フォームの現在のコードを以下に変更
Sheet2で使いたい場合Sheet1をSheet2に変更。

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim CSetList As Class1
Dim i As Long
'押されたキーが、Enterキー以外は終了
If KeyCode <> vbKeyReturn Then Exit Sub

'テキスト部分が選択されている場合
If ComboBox1.ListIndex = -1 Then
ComboBox1.Visible = False 'コンボボックスを非表示
ComboBox1.Visible = True 'コンボボックスを表示
Set CSetList = New Class1
Call CSetList.SetList(Sheets("Sheet1"), FormMain)
Set CSetList = Nothing
End If

KeyCode = 0
ComboBox1.DropDown 'リストを表示

End Sub

Private Sub ComboBox1_Change()
Dim CLabel As Class1
Set CLabel = New Class1

Call CLabel.SetLabel(Sheets("Sheet1"), FormMain)

Set CLabel = Nothing
End Sub