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.12

kkkkkm

> classの方はindexが有効範囲にありません、と却下されました。

指定したSheetやLabelなどが無い時に出ると思います。

> 標準モジュールの、引数はどのように書けば良いのでしょうか？

たとえば
ComboBox1 → Sheet1、Label1、Label2
ComboBox2 → Sheet2、Label3、Label4
対応の場合

フォームモジュールに

Private Sub ComboBox1_Change()
Call mCombo_Change(ComboBox1, Sheets("Sheet1"), 1, 2)
End Sub

Private Sub ComboBox2_Change()
Call mCombo_Change(ComboBox2, Sheets("Sheet2"), 3, 4)
End Sub

標準モジュールに

Sub mCombo_Change(ByRef mCombo As ComboBox, ByRef mSheet As Worksheet, ByVal LabelA As Long, ByVal LabelB As Long)
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:=mCombo.Text, LookIn:=xlValues)
If Not mRng Is Nothing Then
FormMain.Controls("Label" & LabelA).Caption = .Cells(mRng.Row, 1)
FormMain.Controls("Label" & LabelB).Caption = .Cells(mRng.Row, 4)
End If
End With
End Sub

お礼

無事解決しました、ありがとうございました。
シート切り替えは、標準モジュールに以下を作成
Sub activeSheetをsheet1に変更()
Sheets(1).Select
End Sub
Sub activeSheetをsheet2に変更()
Sheets(2).Select
End Sub

フォーム
Private Sub ComboBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Call activeSheetをsheet2に変更
'押されたキーが、Enterキー以外は終了
If KeyCode <> vbKeyReturn Then Exit Sub
Call ComboList(ComboBox2, ActiveSheet)
KeyCode = 0
ComboBox2.DropDown 'リストを表示
End Sub

回答No.10

kkkkkm

フォームを2個は開かないという事ですので、これは蛇足の蛇足です。
現状の1個がうまくいった後で、暇と興味があれば試してみてください。
うまくいかなければ「ぼつ」にしてください。

新規UserForm2に
ComboBox1とLabel1とLabel2を作成して

フォームモジュールに

Public Sub Init(ByVal CapText As String, ByVal mLeft As Long, ByVal mTop As Long)
Dim myAry As Variant

Caption = CapText
myAry = Sheets(Caption).Range("B1:B9")'セル範囲は適当です。
ComboBox1.List = myAry
StartUpPosition = 0
Left = mLeft
Top = mTop

End Sub

Private Sub ComboBox1_Change()
Call SetLabel(Sheets(Caption), Me)
End Sub

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

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

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

End Sub

現状の標準モジュールに以下を追加して実行すると、UserForm2のフォーマットでSheet1,Sheet2にそれぞれ対応したフォームが開きます。
表示位置は適当です。

Sub ShowUForm()
Dim uForm As UserForm2
Dim uForm2 As UserForm2

Set uForm = New UserForm2

With uForm
.Init "Sheet1", 400, 200
.Show vbModeless
End With

Set uForm2 = New UserForm2

With uForm2
.Init "Sheet2", 700, 200
.Show vbModeless
End With

End Sub

回答No.9

kkkkkm

> mForm.Label1.Caption = .Cells(mRng.Row, 1)
> mForm.Label2.Caption = .Cells(mRng.Row, 4)
> でオブジェクトは、このプロパティまたはメソッドをサポートしていません、とエラー吐いてしまいました。

Labelのオブジェクト名(Label1,Label2)が違ったりLabelがLabelじゃなくてCaptionのないオブジェクト(テキストボックスなど)だったりするとそのエラーがでますが、そのあたりはいかがですか。

MsgBox mRng.Row
mForm.Label1.Caption = .Cells(mRng.Row, 1)
mForm.Label2.Caption = .Cells(mRng.Row, 4)

とするとメッセージボックスに数値(セルの行番号になります)がでると思いますがどうでしょう。

ComboBox1.Selected
ComboBoxに.Selectedというメンバは無いと思いますよ。

補足

mForm.Label1.Caption = .Cells(mRng.Row, 1)
mForm.Label2.Caption = .Cells(mRng.Row, 4)
は解決しました。（フォーム側Labelの設定ミスでした、ごめんなさい）。

combobox1(sheet1参照)では動きましたが、combobox2から８(sheet2参照)で、標準モジュールに同じように書き直しですかね・・・。
combobox番号:sheet2の１列目参照とsheet2の４列目参照
combobox2:label4と５
combobox３:label6と7
combobox4:label8と9
combobox5:label10と11
combobox6:label12と13
combobox7:label14と15
combobox8:label16と17
と同じ書き方が続くのでプログラムをまとめるのがたかったのですが・・・。
まあwebで調べながら応用できるようにもう少し試してみます。

回答No.8

kkkkkm

No.7の訂正です。

山を確定した時点(KeyDownが実行されず検索していない状態)

じゃなくて

山を確定した時点(KeyDownが実行されない状態)

でした。
リストのアイテムを更新するときにある意味検索だったので検索と考えたのですが、Labelの方の検索でしたね。

回答No.7

kkkkkm

> Call CSetList.SetList(Sheets("Sheet1"), FormMain)
> Call CLabel.SetLabel(Sheets("Sheet1"), FormMain)
> で、インデックスが有効範囲にありません。
> とエラーを吐いてしまいました。

指定したシートなどがないときに出るエラーで、元のコードのシート名とフォーム名をそのまま利用しているのでエラーにならないと思いましたが

とりあえずシート名やフォーム名指定ではなく利用中のという形で

標準モジュール利用で

Call SetList(ActiveSheet, Me)
Call SetLabel(ActiveSheet, Me)

にしてみてください。

> 山で検索してEnter押した途端にlabel表示するchengeプログラムが反応してる

山を確定した時点(KeyDownが実行されず検索していない状態)でChangeが実行されますので
No.1の最初に書いた状態でエラーですね。
ちなみに、Do～LoopのままだとLongにしてもエラーになります。

> フォームを同時に２つ開く作りにはしてませんね

それでしたらクラスにすることもないのではと思えます。
各イベントをクラスに押し込んで、フォームモジュールに各イベントが無いと後から見た人がクラスを知らなければ涙目になるかもしれません。

標準モジュールにイベントで実行する共通コードを記載して、フォームモジュールから必要な引数をつけて呼び出すという方法でいいのではないでしょうか。

補足

Call SetList(ActiveSheet, Me)
Call SetLabel(ActiveSheet, Me)
に変えたら、通りました。

mForm.Label1.Caption = .Cells(mRng.Row, 1)
mForm.Label2.Caption = .Cells(mRng.Row, 4)
でオブジェクトは、このプロパティまたはメソッドをサポートしていません、とエラー吐いてしまいました。
Set mRng = fRng.Find(What:=mForm.ComboBox1.Text, LookIn:=xlValues)
のWhat:=mForm.ComboBox1.Text, →What:=mForm.ComboBox1.Selected, とかだったり？

回答No.6

kkkkkm

No.5の追加です。

ふと思ったこと
使い方がよく分からないのですが、たとえば同じフォームを開いたままでSheet1で探したりSheet2で探したりとかだとシート指定するComboBox作ってそこで指定してもいいのかなと思えます。

で、ComboBox2でしたら

Call SetList(Sheets(ComboBox2.Value), FormMain)

みたいな感じでシートの指定をすればいけるのではないかと思えます。

補足

No1とNo2については、
Call CSetList.SetList(Sheets("Sheet1"), FormMain)
Call CLabel.SetLabel(Sheets("Sheet1"), FormMain)
で、インデックスが有効範囲にありません。
とエラーを吐いてしまいました。
呼び出し方が間違ってるのかな？

質問で書いたKeyDown検索codeは、コンボボックスに山と入力してenter押すと山田・山口・山本など山がつく名前がずらっとリスト表示されて希望通り。まあ山だけ１文字の名前の人居ないからlabelがエラー吐いてるっぽい事を除けば(つまり山で検索してEnter押した途端にlabel表示するchengeプログラムが反応してるんじゃないかと予想してるが、直し方分からんのが原因？;;)

まあ標準＆classモジュールに書いてformで呼び出し無理そうなら・・・formに、「ComboBoxによる検索」をPublicFunctionで書いてcallで呼び出したほうがいいのか？とも考えています。

回答No.5

kkkkkm

No.2の追加です。

フォームを同時に別シート参照で二つ開くことが無いのでしたらクラスにすることもないと思います。

No.3で補足したようにActiveSheetで開いているシートを参照することもできますが、フォームを開く時にシートを指定するというのもありかもしれません。

標準モジュールでグローバル変数を
Public GmSheet As Worksheet
みたいに宣言して

フォームを開く時に参照シートを指定して

Set GmSheet = Sheets("Sheet1")
FormMain.Show

Call SetList(Sheets("Sheet1"), FormMain)
を
Call SetList(GmSheet, FormMain)
のように
他の
Sheets("Sheet1")のところもGmSheetに変更すればNo.2の標準モジュールはそのまま使えます。

補足

フォームを同時に２つ開く作りにはしてませんね（操作側が、１つ目のフォーム開いて、１つ目のフォーム内でクリックしたら２つ目のフォーム開いた場合に、途中で電話とか入った場合→電話終了後に複数フォーム開いてると何処まで進めてたか思い出すの手間取るor忘れてたり、で次の一手で誤操作やった時のエラー対策とかも書く必要出てきそうなので）。
１つのフォームでSheetは２つ参照、１つのComboBoxにつきSheetを1つ参照(複数Sheet参照することは無い・というか複数Sheet参照しないようにexcelシートを作り直した)。
伝票印刷フォームでComboBox検索絞り込みを８回(顧客名１回・品名７回)・ComboBox結果からのlabel反映８回使うかフォーム、なのでclassモジュールor標準モジュール使用に書いて、呼び出すように作った方が良いかなと。別tab(新規登録＆変更途)で各２回呼び出す事になる。
元プログラム(Access)は伝票印刷、米(政府基準農薬の1/10以下の減農薬コシヒカリ(10kg3300円＋送料)を直売してる営農組合(30kg✖年間150本くらい)。
・マルチページtabで伝票印刷フォーム・顧客名の新規登録＆変更・品名の新規登録＆変更、誤操作防ぐために３つに分ける。
vecterなどで代用出来る物も探したのですが、担当部署・取引先ランク(ランク違うと売値変わる)・担当者名・金融機関選択、など使わない項目が大量に付いてたので自分で作ったほうが良いかなと。

回答No.4

imogasi

小生も（多分似たような）課題に関心があり、勉強中なので、質問への感想？を述べさせてください。参考になれば。
ーー
２５０件と件数が多いことが、本課題（VBAコード以前の段階の、コードを作る以前の、設計（道具立て）というか、対処法を考える上で、）を難しくしているように思う。
「量は質を決す」と言われるように、数量が多いと、別の方式を考えざるを得ないことが多い。
普通の「コントロール（コンボボックスなどの部品）」解説書の例題などは（Itemが、本件では候補氏名の数）１０－２０件以内の解説が多い。
（１）まず、この課題に対する対処のための設計思想が、適当かどうか、経験者に聞くべきと思う。
私は、本質問のやり方は、失礼ながら、初心者らしいなと思った。
２５０件もあるもの（氏名）から、複数件か（１件か？）を選ばせる課題ではないか、と思うが、
どの部品・種類を使うのにしろ、コントロールの利用（のための勉強）が難しいのでは。
また２５０件を、操作者がスクロールして探すのは大変です。
ーー
（設計思想の件）
まず、氏名かなの最初の２ー３文字（ぐらい）から絞り込み、絞り込んだ対象で、コンボなどを使って、決定させるのが普通（ベター）ではないか？氏名カナデータを持つ必要と、氏名漢字ーー＞読み仮名は多様性（例　正田＝＞ショウダかマザダか）のため、初めてのものには正しい読みに行きつかない恐れが多い、新しい別の「恐れ」が出てくるが。
元々氏名には属人コードを振ることが多いと思うが。
（普通の解説書に出ている対処法について）
同種のコントロールをたくさん並べて、そのうちの１つ（複数）選ばせて、（例クリックイベントを捉え）、そのどれを選んだかのインデックスを割り出す方法が解説される。
この際「クラスの利用」が説かれる。と言っても「WithEvents 」という局所的な課題ですが。
普通(初級、中級、上級の下くらいでは）VBA利用では、「クラスの利用」は、ほとんどなしで済まされる（済む）ので、根本（クラス）にはいるのは（特に独学では）、理解が難しい。
Ｊａｖａなどで別に仕事で鍛えられた人は別ですが。
VB6での、コントロール配列を、ＶＢＡでは、正面から認めないのが、そういう難しさの一端かな。
小生は、コード記述が「クラスモジュール」「標準モジュール」「一般」に別れることに、注意が必要な点が難しかった。
＝＝
この質問の課題には、エクセルよりアクセス（ＶＢＡ）など、SQLを自在に使えるソフトで、一般に、やさしく、的を絞っていけるソフトの利用が望ましいと思う。
「かな氏名先頭での絞り」も普通に選択肢に入ってくると思う。
ーー
上記「普通の解説書に出ている対処法」のWEB記事（の１例）は
https://blog.goo.ne.jp/pc_college/e/9ca2b0c452e9e691cad1dbd2783868cf
複数のコントロールのイベントを一つのプロシージャにまとめる(ExcelVBA)
ほか多数。
指定する検索語によって、で出てくる記事が相当変わりますが。
「VBA 多数の同種コントロール　クラス利用」でやって見たもの。

補足

「氏名かなの最初の２ー３文字」も考えとしてはアリなんだけど、氏名(フルネーム)が解ってるので、氏名の一番最初の漢字一文字で、条件絞り込みするのが良いと考えたのよ(着想はexcelのデーターのフィルターのオプションの「〇〇を含む」絞り込み)、まあgoogle検索によるwebサイトの検索感覚。
A列は当然ながらIDナンバーにしてるが、IDナンバーで氏名覚えてる人居ないからB列の氏名で検索(元データはコンボボックス全件表示でIDと氏名が表示されてたが、IDで氏名を思い浮かべれる人居ると思えないので、氏名だけの検索＆選択に移行)。

ComboBoxで250件程度全件読み込み＋対応label表示はネットで調べながら自分でvba完成出来たのよ(ちゃんと希望通りの動きした)。
でも250件からの宝探し現状維持はダメだ(実際に「氏名＆住所で全く同じ人」をid複数件登録しちゃってるし;;(excelのオートフィルター使って確認済)。
約250件の氏名をあ行・か行ーわ行の１０分割する案も考えたが新規登録のときに困るのよ(登録の時に、氏名の列指定が１０列に増えるorシート１０枚に増えるので、登録先の指定プログラム書く時に複雑になる)、同種のコントロールをたくさん並べられると操作側も探す手間増える(氏名で先田でサキダorセンダって読む場合有るからカナ検索も一難抱えてると思ってる)。
classモジュールを出来れば使いたいって言うのは個人的な我儘（プログラム長いほど、１：誰かが操作ミスしちゃって一部消しちゃったとかミス有った時に困るのよ。２：長けれれば長いほどミス箇所探すの時間かかる＋コンピュター側の読み込み不可も大きくなる。３：私が居なくなった時に、新項目追加したい時とか出てくるかもしれないじゃない＝でも長いプログラムだと追加項目書く場所を探すだけで心が折れるのよ）。
あ！一応CNC旋盤のプログラム自分で組む＆金属加工やってたから、長いプログラム組むと後で困る事あるのがちょっと実感有るのよ(少しでもプログラム短くする＆プログラムの打ち間違い減らす、subプログラムを出来る限り活用するのがミスを最小限に減らす＆他の人(会社とかなら引き継ぎ有るor後輩に教える側に回る場合も有る)が見た時に「心が折れないように」してあげる)。
私個人の我儘だから、こんな人もいるんだくらいの感じで・・・。

回答No.3

kkkkkm

No.1の補足です。

Sheets("Sheet1")
を
ActiveSheet
にすれば表示しているシートが対象になります。

回答No.2

kkkkkm

No.1の追加です。

クラスにしなくても標準モジュールにNo.1のクラスのコードを記載して

フォームのコードを以下にしてもいいような気もします。

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

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

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

End Sub

Private Sub ComboBox1_Change()
Call SetLabel(Sheets("Sheet1"), FormMain)
End Sub