質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

2回答

3642閲覧

ユーザーフォームの名前を標準モジュールの関数に渡したい(添付画像有)

hachi3156

総合スコア16

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2019/07/22 09:08

前提・実現したいこと

ExcelVBA(Excel2019)で部品マスタの更新用ユーザーフォームを作成しています。
部品の情報は各部品に固有の品番で管理しており、部品の品名、型式、メーカー名、仕入先などを更新・修正する場合の使用を想定しています。

添付画像左上にあるFrmUpdateが更新用のユーザーフォームです。
更新したい品番を入力して、検索ボタンをクリックするとその品番にひもづく品名や型式名、メーカー名、仕入先名などがそれぞれのテキストボックスに表示されるようにしました。

最初に更新フォームを作成したときは、下記28行目や42行目のwhatの対象をFrmUpdate.txtMakerCode(28行目),FrmUpdate.txtMaker(42行目)にしていました。
しかし、それをFrmUpdate.txtMakerのようにユーザーフォームを固定するのではなく、複数のユーザーフォームで行えるように標準モジュールの関数に引数を渡して実行できるようにコードを変更したら、コードは表示されるのに、それにひもづくメーカー名が表示されませんでした。

どのように書けば、複数のユーザーフォームで標準モジュールの関数を使用することができるのでしょうか

標準モジュールの関数を使用したいのはFrmUpdateとFrmSearchの2つです。

excelvbaの初心者なため、まだ知らないことが多いので丁寧に教えていただければ幸いです。

イメージ説明

発生している問題・エラーメッセージ

ユーザーフォームのテキストボックスに正しい結果が反映されない

該当のソースコード

・ユーザーフォーム FrmUpdate Private Sub btnFindPart_Click() With FrmUpdate ~前略~ 'メーカー With .txtMaker .Enabled = True .BackColor = &H80000005 If FrmUpdate.txtMakerCode <> "" Then Call ProcMaker("NAME", "FrmUpdate") End If End With ~後略~ End With End Sub ・ユーザーフォーム FrmSearch Private Sub btnFind_Click() Call ProcMaker("FIND","") End Sub ・標準モジュール 定数定義 ~前略~ Public Const メーカーマスタ採番台帳 = "メーカーマスタ採番台帳.xlsm" Public Const メーカーコード割当 = "メーカーコード割当" ~後略~ ・標準モジュール UserForm ~前略~ Public SlctForm As String Public ProcMakerMode As String ~後略~ 1Function ProcMaker(ByVal ProcMakerMode As String, ByVal SlctForm As 2String) 'メーカー関連の処理:メーカー名⇔コード変換、メーカー名検索 3 4 Dim MaxRow As Integer 5 Dim MaxCol As Integer 6 7 Dim FindMaker As Range 8 Dim MakerOutput As Range 9 10 Workbooks.Open Filename:=ActiveWorkbook.Path + "\" & メーカーマスタ採番台帳, ReadOnly:=True 11 Windows(メーカーマスタ採番台帳).Visible = False 12 13 Set MakerMaster = Workbooks(メーカーマスタ採番台帳) 14 Set wsMM = MakerMaster.Worksheets(メーカーコード割当) 15 16 '検索範囲の設定 17 With wsMM 18 MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row 19 MaxCol = .Cells(1, Columns.Count).End(xlToLeft).Column 20 21 Set FindMaker = .Range(.Cells(2, 1), .Cells(MaxRow, MaxCol)) 22 End With 23 24 MsgBox UserForms.Add(SlctForm).Name 25 'メーカーコードからメーカー名を探す 26 If ProcMakerMode = "NAME" Then 27 28 Set MakerOutput = FindMaker.Find(what:=UserForms.Add(SlctForm).txtMakerCode, _ 29 After:=wsMM.Cells(2, 1), _ 30 LookIn:=xlValues, _ 31 LookAt:=xlWhole, _ 32 Searchorder:=xlByRows, _ 33 searchdirection:=xlNext, _ 34 MatchCase:=False, _ 35 matchbyte:=False) 36 37 UserForms.Add(SlctForm).txtMaker = MakerOutput.Offset(0, 1).Value 38 39 'メーカー名からメーカーコードを探す 40 ElseIf ProcMakerMode = "CODE" Then 41 42 Set MakerOutput = FindMaker.Find(what:=UserForms.Add(SlctForm).txtMaker, _ 43 After:=wsMM.Cells(2, 1), _ 44 LookIn:=xlValues, _ 45 LookAt:=xlWhole, _ 46 Searchorder:=xlByRows, _ 47 searchdirection:=xlNext, _ 48 MatchCase:=False, _ 49 matchbyte:=False) 50 51 UserForms.Add(SlctForm).txtMakerCode = MakerOutput.Offset(0, -1).Value 52 53 'メーカー名検索、プルダウン選択 タイミング:メーカー検索ボタンクリック 54 ElseIf ProcMakerMode = "FIND" Then 55 56 'cf. https://tonari-it.com/excel-vba-change-event-validation-list-find/ 57 Dim objCustom As Object 58 Dim strAdr As String '検索範囲内で最初にヒットしたセル 59 Dim Target As Variant '検索対象 60 61 'テキストボックス「検索対象」に入力した文字をtargetに格納 62 Target = FrmSearch.txtSearchObj 63 64 '部分一致した全会社名をプルダウンリストに表示 65 Set objCustom = FindMaker.Find(what:=Target, LookAt:=xlPart) 66 67 If objCustom Is Nothing Then 68 Target.Value = Target.Value 69 Else 70 '1件目を文字列にセット 71 strAdr = objCustom.Address 72 73 With FrmSearch.cmbResult 74 75 .Clear 76 .AddItem objCustom 77 78 End With 79 80 Do 81 Set objCustom = FindMaker.FindNext(objCustom) 82 83 If objCustom Is Nothing Then 84 Exit Do 85 Else 86 If strAdr <> objCustom.Address Then 87 88 FrmSearch.cmbResult.AddItem objCustom 89 90 End If 91 92 End If 93 94 Loop While Not objCustom Is Nothing And objCustom.Address <> strAdr 95 96 End If 97 Else 98 99 MsgBox "コードエラー" & vbCrLf & "[NAME],[CODE],[FIND]のうちいずれかを選択" 100 101 End If 102 103 Application.DisplayAlerts = False 104 Workbooks(メーカーマスタ採番台帳).Close 105 106End Function

試したこと

24行目では正しくFrmUpdateとメッセージボックスに表示されていたので、引数の引渡は問題ないと考えているのですが、そこから先をどう対処すればよいのかわかりません。

補足情報(FW/ツールのバージョンなど)

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答2

0

まず、UserForms.Add というのはAddというメソッド名が想像できると思いますが、フォームを生成してUserFormsコレクションに追加するものです。

標準モジュールに下記のコードを記述して実行してみてください。(FrmUpdate は存在するユーザーフォーム名にしてください。)

vba

1Public Sub Test() 2 3 UserForms.Add ("FrmUpdate") 4 UserForms.Add ("FrmUpdate") 5 UserForms.Add ("FrmUpdate") 6 Debug.Print "生成されているユーザーフォームの数: " & UserForms.Count 7 8 Dim i As Long 9 For i = 0 To UserForms.Count - 1 10 Debug.Print i + 1 & "番目のフォーム名: " & UserForms(i).Name 11 UserForms(i).Show vbModeless 12 Next 13 14 Stop 15 16 For i = UserForms.Count - 1 To 0 Step -1 17 Unload UserForms(i) 18 Next 19End Sub

Stopの行でコードが中断しますので、そこでイミディエイトウィンドウを確認してみてください。
下記のように表示されているはずです。

text

1生成されているユーザーフォームの数: 3 21番目のフォーム名: FrmUpdate 32番目のフォーム名: FrmUpdate 43番目のフォーム名: FrmUpdate

UserForm1 が3つ生成されていることが分かります。
また、表示されているフォームをマウスで移動させてみてください。
フォームが3枚表示されていることが分かります。
確認出来たら、VBAウィンドウに戻って F5 キーを押してコードの続きを実行してください。
Unload でフォームをメモリから解放します。これをしないとメモリにフォームが残ってしまいます。

つまり、'UserForms.Add(SlctForm).txtMakerCode' は今、開いているユーザーフォームとは別のフォームを生成していることになりますので、開いているユーザーフォームのテキストボックスの値を取得できません。また、生成したまま解放してないので、メモリ上に残ってしまいます。

では、どうするかというと、今開いているフォーム=自分自身のフォームを引数で渡せばいいのです。

コード例

vba

1'・ユーザーフォーム FrmUpdate 2Private Sub btnFindPart_Click() 3 4 Call ProcMaker("NAME", Me) 5 6End Sub 7 8 9'・標準モジュール "UserForm"という名前はNG、MSFormsのUserFormと被るので 10 11Function ProcMaker(ByVal ProcMakerMode As String, SlctForm As slctForm As MSForms.UserForm) 12 13 14 MsgBox SlctForm.txtMakerCode.Value 15 16End Function

投稿2019/07/22 11:34

編集2019/07/22 11:36
hatena19

総合スコア33620

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

ttyp03

2019/07/22 23:36

UserForms.Addは私も「ん?」と思ったのですが、調べてみるとかつてはMS公式情報としてあったようですね。 実際に動かしてみるときちんと値も取れていました。 http://officetanaka.net/excel/vba/tips/tips103.htm ※MSのページは現在削除されているようです
hachi3156

2019/07/23 01:21

hatena19様 質問の体裁が整っていないなかご回答くださり誠にありがとうございます。 確認用コードまで記載してくださり、自分がつまづいていた点が良く理解できました。 頂いたコードをもとに下記コードを実行したら、自分が行いたい内容がきちんと表示されました。 ありがとうございます。 後学のために伺いたいのですが、今までテキストボックスの内容を取得する場合は.textを使用していたため、試しに.valueを.textに変えてみたところ、表示内容に差が見られませんでした。 調べてみたら、リストボックスの場合は違いがあるようですが、テキストボックスの場合も何か違いがあるのでしょうか? http://officetanaka.net/excel/vba/tips/tips143.htm ・ユーザーフォーム With Me With .txtMaker .Enabled = True .BackColor = &H80000005 If FrmUpdate.txtMakerCode <> "" Then Call ProcMaker("NAME", Me) End If End With End With ・標準モジュール Function ProcMaker(ByVal ProcMakerMode As String, slctForm As MSForms.UserForm) 'MsgBox slctForm.txtMakerCode.Value Dim MakerMaster As Workbook Set MakerMaster = Workbooks.Open(Filename:=ActiveWorkbook.Path + "\" & メーカーマスタ採番台帳, ReadOnly:=True) 'Windows(メーカーマスタ採番台帳).Visible = False Dim win As Window For Each win In MakerMaster.Windows win.Visible = False Next win Dim wsMM As Worksheet Set wsMM = MakerMaster.Worksheets(メーカーコード割当) '検索範囲の設定 Dim MaxRow As Long Dim MaxCol As Long Dim FindMaker As Range With wsMM MaxRow = .Cells(.Rows.Count, 1).End(xlUp).Row MaxCol = .Cells(1, .Columns.Count).End(xlToLeft).Column Set FindMaker = .Range(.Cells(2, 1), .Cells(MaxRow, MaxCol)) End With 'メーカーコードからメーカー名を探す If ProcMakerMode = "NAME" Then Set MakerOutput = FindMaker.Find(What:=slctForm.txtMakerCode.Value, _ After:=wsMM.Cells(2, 1), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ Searchorder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False, _ MatchByte:=False) slctForm.txtMaker.Value = MakerOutput.Offset(0, 1).Value End If End Function
hatena19

2019/07/23 01:36

> 試しに.valueを.textに変えてみたところ、表示内容に差が見られませんでした。 ExcelのセルやAccessのテキストボックスでは、Text と Value では明確に違いがありますが、ユーザーフォームのテキストボックスはどちらも常にString型で同じになるようです。
hatena19

2019/07/23 01:40

あと、質問事項だけに回答しましたが、ProcMakerプロシージャ自体はいろいろ改善の余地はあります。imihitoさんの回答のアドバイスを参考に設計の見直しをされることをお勧めします。
hachi3156

2019/07/23 02:35

hatena19様 追加質問にもご回答くださりありがとうございます。 ユーザーフォームのテキストボックスではtextとvalueで差は見られないとのこと、理解いたしました。 まだまだ未熟者のため、いただいたアドバイスに沿って見直ししてみます。 調べて分からないことはまたこのような場で質問させていただくため、もしかしたらまたお手数をおかけすることがあるかもしれません。 最後に貴重なお時間を割いてまで回答並びにコメントくださり誠にありがとうございました。
guest

0

ベストアンサー

内容の前に質問の体裁として

行番号はわざわざ付けなくていいです。
VBA自体は行番号をサポートしているので、サポートされている範囲で付けるのはいいですが、今の付け方はVBAの構文として成り立っていないため、回答者側でコードをコピペできず、手で修正する必要があります。
そのため内容の確認がやりにくくなり、回答がつきにくくなります。


まずは、質問のコードを整形だけした物です

・ユーザーフォーム FrmUpdate

vba

1'・ユーザーフォーム FrmUpdate 2Private Sub btnFindPart_Click() 3 4 With FrmUpdate 5 '~前略~ 6 'メーカー 7 With .txtMaker 8 .Enabled = True 9 .BackColor = &H80000005 10 If FrmUpdate.txtMakerCode <> "" Then 11 Call ProcMaker("NAME", "FrmUpdate") 12 End If 13 End With 14 '~後略~ 15 End With 16End Sub

・ユーザーフォーム FrmSearch

vba

1'・ユーザーフォーム FrmSearch 2Private Sub btnFind_Click() 3 Call ProcMaker("FIND", "") 4End Sub

・標準モジュール 定数定義

vba

1'・標準モジュール 定数定義 2 3'~前略~ 4Public Const メーカーマスタ採番台帳 = "メーカーマスタ採番台帳.xlsm" 5Public Const メーカーコード割当 = "メーカーコード割当" 6'~後略~

・標準モジュール UserForm

vba

1'・標準モジュール UserForm 2 3'~前略~ 4Public SlctForm As String 5Public ProcMakerMode As String 6'~後略~ 7 8Function ProcMaker(ByVal ProcMakerMode As String, ByVal SlctForm As String) 'メーカー関連の処理:メーカー名⇔コード変換、メーカー名検索 9 Dim MaxRow As Integer 10 Dim MaxCol As Integer 11 12 Dim FindMaker As Range 13 Dim MakerOutput As Range 14 15 Workbooks.Open Filename:=ActiveWorkbook.Path + "\" & メーカーマスタ採番台帳, ReadOnly:=True 16 Windows(メーカーマスタ採番台帳).Visible = False 17 18 Set MakerMaster = Workbooks(メーカーマスタ採番台帳) 19 Set wsMM = MakerMaster.Worksheets(メーカーコード割当) 20 21 '検索範囲の設定 22 With wsMM 23 MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row 24 MaxCol = .Cells(1, Columns.Count).End(xlToLeft).Column 25 26 Set FindMaker = .Range(.Cells(2, 1), .Cells(MaxRow, MaxCol)) 27 End With 28 29 MsgBox UserForms.Add(SlctForm).Name 30 'メーカーコードからメーカー名を探す 31 If ProcMakerMode = "NAME" Then 32 33 Set MakerOutput = FindMaker.Find(what:=UserForms.Add(SlctForm).txtMakerCode, _ 34 After:=wsMM.Cells(2, 1), _ 35 LookIn:=xlValues, _ 36 LookAt:=xlWhole, _ 37 Searchorder:=xlByRows, _ 38 searchdirection:=xlNext, _ 39 MatchCase:=False, _ 40 matchbyte:=False) 41 42 UserForms.Add(SlctForm).txtMaker = MakerOutput.Offset(0, 1).Value 43 44 'メーカー名からメーカーコードを探す 45 ElseIf ProcMakerMode = "CODE" Then 46 47 Set MakerOutput = FindMaker.Find(what:=UserForms.Add(SlctForm).txtMaker, _ 48 After:=wsMM.Cells(2, 1), _ 49 LookIn:=xlValues, _ 50 LookAt:=xlWhole, _ 51 Searchorder:=xlByRows, _ 52 searchdirection:=xlNext, _ 53 MatchCase:=False, _ 54 matchbyte:=False) 55 56 UserForms.Add(SlctForm).txtMakerCode = MakerOutput.Offset(0, -1).Value 57 58 'メーカー名検索、プルダウン選択 タイミング:メーカー検索ボタンクリック 59 ElseIf ProcMakerMode = "FIND" Then 60 61 'cf. https://tonari-it.com/excel-vba-change-event-validation-list-find/ 62 Dim objCustom As Object 63 Dim strAdr As String '検索範囲内で最初にヒットしたセル 64 Dim Target As Variant '検索対象 65 66 'テキストボックス「検索対象」に入力した文字をtargetに格納 67 Target = FrmSearch.txtSearchObj 68 69 '部分一致した全会社名をプルダウンリストに表示 70 Set objCustom = FindMaker.Find(what:=Target, LookAt:=xlPart) 71 72 If objCustom Is Nothing Then 73 Target.Value = Target.Value 74 Else 75 '1件目を文字列にセット 76 strAdr = objCustom.Address 77 78 With FrmSearch.cmbResult 79 80 .Clear 81 .AddItem objCustom 82 83 End With 84 85 Do 86 Set objCustom = FindMaker.FindNext(objCustom) 87 88 If objCustom Is Nothing Then 89 Exit Do 90 Else 91 If strAdr <> objCustom.Address Then 92 FrmSearch.cmbResult.AddItem objCustom 93 End If 94 End If 95 Loop While Not objCustom Is Nothing And objCustom.Address <> strAdr 96 End If 97 Else 98 MsgBox "コードエラー" & vbCrLf & "[NAME],[CODE],[FIND]のうちいずれかを選択" 99 End If 100 101 Application.DisplayAlerts = False 102 Workbooks(メーカーマスタ採番台帳).Close 103 104End Function

ここからが回答本編です。

まず問題としてProcMakerの処理内でUserForms.Add(SlctForm)で毎回ユーザーフォームを新しく作っている点です。
毎回新規に作っている以上、What:=には初期値しか入りませんし、結果を入れても新しく作ったユーザーフォームは裏で待機しているだけなので呼び出し元には何も返ってこないはずです。

では、ということで対策を考えていきたいところですが、ProcMakerのプロシージャが役割を持ちすぎていて、ミスを埋め込みやすいので、まずはそこから整理していきます。

ProcMakerの分離

コードを見る限り、FrmUpdateが使うのはProcMakerMode"NAME"のときと"CODE"のときだけで、"FIND"FrmSearchからしか使われないのでしょう。
このようにバラバラな事をしていると扱いにくいので、ここを分離します。

また、"NAME""CODE"のそれぞれときのIf文の中身ですがメーカーコード/メーカー名 を検索し、見つかったセルの1列 右/左 のセルの値を メーカー名/メーカーコードとして出力する、とほぼ同じことをしています。
このあたりコードを個人的に使いやすく整理すると、以下のコードのProcMakerForUpdateのようになります。

vba

1Public Function FindMakerNameByCode(MakerCode As String) As String 2 FindMakerNameByCode = ProcMakerForUpdate("NAME", MakerCode) 3End Function 4 5Public Function FindMakerCodeByName(MakerName As String) As String 6 FindMakerCodeByName = ProcMakerForUpdate("CODE", MakerName) 7End Function 8 9'メーカー関連の処理:メーカー名⇔コード変換 10Function ProcMakerForUpdate(ByVal ProcMakerMode As String, ByVal MakerNameOrCode As String) As String 11 'Workbooks.Open Filename:=ActiveWorkbook.Path + "\" & メーカーマスタ採番台帳, ReadOnly:=True 12 'Set MakerMaster = Workbooks(メーカーマスタ採番台帳) 13 Dim MakerMaster As Workbook 14 Set MakerMaster = Workbooks.Open(Filename:=ActiveWorkbook.Path + "\" & メーカーマスタ採番台帳, ReadOnly:=True) 15 16 'Windows(メーカーマスタ採番台帳).Visible = False 17 Dim win As Window 18 For Each win In MakerMaster.Windows 19 win.Visible = False 20 Next win 21 22 Dim wsMM As Worksheet 23 Set wsMM = MakerMaster.Worksheets(メーカーコード割当) 24 25 '検索範囲の設定 26 Dim MaxRow As Long 27 Dim MaxCol As Long 28 Dim FindMaker As Range 29 With wsMM 30 MaxRow = .Cells(.Rows.Count, 1).End(xlUp).Row 31 MaxCol = .Cells(1, .Columns.Count).End(xlToLeft).Column 32 Set FindMaker = .Range(.Cells(2, 1), .Cells(MaxRow, MaxCol)) 33 End With 34 35 Dim MakerOutput As Range 36 Set MakerOutput = FindMaker.Find( _ 37 What:=MakerNameOrCode, _ 38 After:=wsMM.Cells(2, 1), _ 39 LookIn:=xlValues, _ 40 LookAt:=xlWhole, _ 41 Searchorder:=xlByRows, _ 42 SearchDirection:=xlNext, _ 43 MatchCase:=False, _ 44 MatchByte:=False _ 45 ) 46 47 Select Case ProcMakerMode 48 Case "NAME" 49 'メーカーコードからメーカー名を探す場合、1列右を見る 50 ProcMakerForUpdate = MakerOutput.Offset(0, 1).Value 51 Case "CODE" 52 'メーカー名からメーカーコードを探す場合、1列左を見る 53 ProcMakerForUpdate = MakerOutput.Offset(0, -1).Value 54 Case Else 55 MsgBox "コードエラー" & vbCrLf & "[NAME],[CODE]のうちいずれかを選択" 56 End Select 57 58 'Application.DisplayAlerts = False 59 'Workbooks(メーカーマスタ採番台帳).Close 60 MakerMaster.Close SaveChanges:=False 61 62End Function

ProcMakerForUpdateを使ってFrmUpdatebtnFindPart_Clickを書き換えると以下のようになります。

ユーザーフォームへの依存が無くなり、検索の種類と検索文字列を指定すれば結果が得られるようになります。

vba

1'・ユーザーフォーム FrmUpdate 2Private Sub btnFindPart_Click() 3 4 With Me 5 '~前略~ 6 'メーカー 7 With .txtMaker 8 .Enabled = True 9 .BackColor = &H80000005 10 If .txtMakerCode <> "" Then 11 .txtMaker.Text = ProcMakerForUpdate("NAME", .txtMakerCode.Text) 12 '以下でも可 13 'Me.txtMaker.Text = FindMakerNameByCode(Me.txtMakerCode.Text) 14 End If 15 End With 16 '~後略~ 17 End With 18End Sub

ここまでの話はあくまで一例ですが、ユーザーフォームを直接渡すよりは、Functionで結果をやりとりした方が、各種依存関係を分離できて見通しが良くなると思います。


以下他に気になった点をいくつか挙げておきます。

Option Explicit が無い

ある程度規模の大きいコードを書く際はOption Explicitを設定しておきましょう。

ユーザーフォームの名前は直接書かず、Meキーワードを使う

ユーザーフォームの中で、ユーザーフォームの名前(FrmUpdateなど)は原則使わないようにしましょう。
実際に動いているユーザーフォームとFrmUpdateが異なる可能性があるためです。

ユーザーフォームの中であればMeを使うことで確実に自分を参照出来るので、できる限りそちらを使いましょう。


vba

1'~前略~ 2Public SlctForm As String 3Public ProcMakerMode As String 4'~後略~

提示されているコードの範囲では上記の宣言は不要です。
紛らわしいだけなので、他で使っていなければ消してしまいましょう。

Integer よい Long

VBA特有の話ですが、整数を扱う場合はIntegerよりLongの方が良いことが多いです。

例えばExcelのシートの行数は100万ぐらいありますが、Integerは3万ぐらいまでしか扱えません。
つまりIntegerを使う場合、Excel100万行使えるのに3万行しか使えない、ということになってしまいます。

Longであれば20億ぐらいまで扱えるので多くの場合は問題無いはずです。

vba

1 Dim MaxRow As Integer 2 Dim MaxCol As Integer

返り値を使う

以下のWorkbooks.Openの結果がMakerMasterなので、ちゃんとそこで取得しておいた方が安全です。

vba

1 Workbooks.Open Filename:=ActiveWorkbook.Path + "\" & メーカーマスタ採番台帳, ReadOnly:=True 2 Windows(メーカーマスタ採番台帳).Visible = False 3 4 Set MakerMaster = Workbooks(メーカーマスタ採番台帳)

vba

1 Dim MakerMaster As Workbook 2 Set MakerMaster = Workbooks.Open(Filename:=ActiveWorkbook.Path + "\" & メーカーマスタ採番台帳, ReadOnly:=True)

.抜け

以下のRowsColumnsの前に.が抜けています。

vba

1 '検索範囲の設定 2 With wsMM 3 MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row 4 MaxCol = .Cells(1, Columns.Count).End(xlToLeft).Column 5 6 Set FindMaker = .Range(.Cells(2, 1), .Cells(MaxRow, MaxCol)) 7 End With

投稿2019/07/22 12:28

imihito

総合スコア2166

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

ttyp03

2019/07/22 23:37

UserForms.Addは私も「ん?」と思ったのですが、調べてみるとかつてはMS公式情報としてあったようですね。 実際に動かしてみるときちんと値も取れていました。 http://officetanaka.net/excel/vba/tips/tips103.htm ※MSのページは現在削除されているようです
hachi3156

2019/07/23 02:10

imihito様 質問した内容以外のことも丁寧にご指摘いただきありがとうございます。 今まで他の人に自分のコードを見てもらうこともこのような場で質問させていただくこともなかったのでご指摘いただいた点を反省し、今後に生かします。 また、ご回答の内容につきまして、メーカー名とメーカーコードの変換処理を1つのコードにまとめ、ユーザーフォームを関数に渡すのではなく、関数の処理結果を渡すという考えも大変勉強になりました。 参考にお伺いしたのですが、仕入先も検索範囲と入出力先のテキストボックスが異なるだけで処理は上記に記載いただいた内容と同じです。 そこで、ProcMakerModeと同じようにメーカーについての処理の場合は"MAKER"、仕入先についての 処理の場合は"VENDOR"としてSelect Caseで選択するといった以下の処理を考えてみたのですが、プログラムの構造としてはまとめたほうが良いのでしょうか、それともシンプルにメーカーと仕入先でプログラムを分離させたほうがよろしいのでしょうか? ・ユーザーフォーム With Me With .txtMaker .Enabled = True .BackColor = &H80000005 If FrmUpdate.txtMakerCode <> "" Then Me.txtMaker.Text = ProcForUpdate("MAKER", "NAME", Me.txtMakerCode.Text) End If End With End With ・標準モジュール Option Explicit Function ProcForUpdate(ByVal MakerOrVendor As String, ByVal ProcMode As String, ByVal NameOrCode As String) As String Dim MaxRow As Long Dim MaxCol As Long Dim TarRng As Range Dim TarSht As Worksheet 'メーカー関連処理か仕入先関連の処理 選択 Select Case MakerOrVendor Case "MAKER" Dim MakerMaster As Workbook Set MakerMaster = Workbooks.Open(Filename:=ActiveWorkbook.Path + "\" & メーカーマスタ採番台帳, ReadOnly:=True) Dim win1 As Window For Each win1 In MakerMaster.Windows win1.Visible = False Next win1 Set TarSht = MakerMaster.Worksheets(メーカーコード割当) '検索範囲の設定 With TarSht MaxRow = .Cells(.Rows.Count, 1).End(xlUp).Row MaxCol = .Cells(1, .Columns.Count).End(xlToLeft).Column Set TarRng = .Range(.Cells(2, 1), .Cells(MaxRow, MaxCol)) End With Case "VENDOR" Dim VendorMaster As Workbook Set VendorMaster = Workbooks.Open(Filename:=ActiveWorkbook.Path + "\" & 仕入先マスタ採番台帳, ReadOnly:=True) Dim win2 As Window For Each win2 In MakerMaster.Windows win2.Visible = False Next win2 Set TarSht = VendorMaster.Worksheets(仕入先コード割当) '検索範囲の設定 With TarSht MaxRow = .Cells(.Rows.Count, 1).End(xlUp).Row MaxCol = .Cells(1, .Columns.Count).End(xlToLeft).Column Set TarRng = .Range(.Cells(2, 1), .Cells(MaxRow, MaxCol)) End With End Select Dim Output As Range Set Output = TarRng.Find( _ What:=NameOrCode, _ After:=TarSht.Cells(2, 1), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ Searchorder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False, _ MatchByte:=False _ ) If ProcMode = "NAME" And MakerOrVendor = "MAKER" Then 'メーカーコードからメーカー名を探す場合、1列右を見る ProcForUpdate = Output.Offset(0, 1).Value ElseIf ProcMode = "CODE" And MakerOrVendor = "MAKER" Then 'メーカー名からメーカーコードを探す場合、1列左を見る ProcForUpdate = Output.Offset(0, -1).Value ElseIf ProcMode = "NAME" And MakerOrVendor = "VENDOR" Then '仕入先コードから仕入先名を探す場合、1列右を見る ProcForUpdate = Output.Offset(0, 1).Value ElseIf ProcMode = "CODE" And MakerOrVendor = "VENDOR" Then '仕入先名から仕入先コードを探す場合、1列左を見る ProcForUpdate = Output.Offset(0, -1).Value Else MsgBox "つづりを確認してください" End If Select Case MakerOrVendor Case "MAKER" MakerMaster.Close SaveChanges:=False Case "VENDOR" VendorMaster.Close SaveChanges:=False End Select End Function
imihito

2019/07/23 16:41

> プログラムの構造としては~ 私個人の考えではありますが、処理はこま切れにして、共通で使える処理と、共通処理を呼び出す条件分岐処理の形にしていきたいです。 --- コードをざっくり見た感じですが、メーカーとベンダーで異なる点は ・開くブックのパス ・シートの名前 の2点だけですよね ProcMode・MakerOrVendorのIf文もProcModeの分岐だけでOKなように見えます。 以下の流れとなるように処理を整理すれば、`Select Case MakerOrVendor`などの重複が減って多少見通しが良くなるはずです。 1. MakerOrVendorに応じて対象のブックのパスとワークシート名を用意する 2. 1.で用意したブックのパスを使ってウィンドウ非表示でブックを開く 3. 1.で用意したワークシート名を使って対象のワークシートを取得する 4. 検索範囲を取得する 5. 検索する 6. ProcModeに応じて値を取得する 7. 2.で開いたブックを閉じる --- 上に書いた「共通で使える処理」に分けるとすると 上記手順の2・4・5あたりが対象になります。 2・4・5の選定理由は以下になります。 ・それなりに行数/文字数をとる処理 ・ほぼ定型の処理 ・FrmSearch側でも似たようなことをしたいので切り出しておけば使いまわせる 実際に切り出してみた例が以下になります。 '2. ウィンドウ非表示でブックを開く Function OpenWorkbookAsReadOnlyAndHidden(BookPath As String) As Workbook Dim wb As Workbook Set wb = Workbooks.Open(Filename:=BookPath, ReadOnly:=True) Dim w As Window For Each w In wb.Windows w.Visible = False Next w Set OpenWorkbookAsReadOnlyAndHidden = wb End Function '4. 左上のセルを基準に拡張した範囲を取得する 'Set TarRng = ExpandRange(TarSht.Cells(2, 1)) 'のように使う Function ExpandRange(TopLeftCell As Range) As Range With TopLeftCell.Worksheet Dim MaxRow As Long, MaxCol As Long MaxRow = .Cells(.Rows.Count, 1).End(xlUp).Row MaxCol = .Cells(1, .Columns.Count).End(xlToLeft).Column Set ExpandRange = .Range(TopLeftCell, .Cells(MaxRow, MaxCol)) End With End Function '5. 検索して最初に見つかったセルを返す 'Set Output = FindFirstValueIn(TarRng, NameOrCode, xlWhole) 'のように使う 'xlValuesを対象にFindを使って検索し、最初の1個(First)を返す Function FindFirstValueIn(TargetRange As Range, FindWhat As Variant, Optional LookAt As XlLookAt = XlLookAt.xlWhole) As Range Set FindFirstValueIn = TargetRange.Find( _ What:=FindWhat, _ After:=TargetRange.Item(1), _ LookIn:=xlValues, _ LookAt:=LookAt, _ Searchorder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False, _ MatchByte:=False _ ) End Function
hachi3156

2019/07/25 06:31

imihito様 夜分遅くにもかからわずご回答くださりありがとうございます。 おかげさまで最初はあんなにも冗長だったコードが今では半分程度まで短くすることができました。 今まではworksheet.range(cell(1,1),cell(2,2))という使い方くらいしかしてこなかったので、記載していただいた関数の中にTopLeftCells.WorksheetやTargetrange.item(1)といった記述を見たときは何だろう?と思いました。 しかし、調べていく中で単純にRangeオブジェクトのプロパティを知らなかっただけと分かり、副次的にRangeオブジェクトに対する理解を深めることもできました。 今回の質問のベストアンサーにつきましては、回答にお答えくださったうえに質問としての体裁、コードを書くうえでのTips、そしてプログラムの構造について様々なことを勉強させていただいたのでimihito様をベストアンサーにいたしました。 最後まで丁寧にご対応くださり誠にありがとうございました。 Option Explicit Function ProcForUpdate(ByVal MakerOrVendor As String, ByVal ProcMode As String, ByVal NameOrCode As String) As String Dim TarBook As Workbook Dim TarSht As Worksheet Dim TarRng As Range Dim Output As Range 'メーカー関連処理か仕入先関連の処理 選択 Select Case MakerOrVendor Case "MAKER" Set TarBook = OpenWorkbookAsReadOnlyAndHidden(ActiveWorkbook.Path + "\" & メーカーマスタ採番台帳) Set TarSht = TarBook.Worksheets(メーカーコード割当) Case "VENDOR" Set TarBook = OpenWorkbookAsReadOnlyAndHidden(ActiveWorkbook.Path + "\" & 仕入先マスタ採番台帳) Set TarSht = TarBook.Worksheets(仕入先コード割当) End Select '検索範囲の設定 Set TarRng = ExpandRange(TarSht.Cells(2, 1)) '検索結果を格納 Set Output = FindFirstValueIn(TarRng, NameOrCode, xlWhole) '検索対象に応じて処理分岐 Select Case ProcMode 'コードから名称を探す場合、1列右を見る Case "NAME" ProcForUpdate = Output.Offset(0, 1).Value '名称からコードを探す場合、1列左を見る Case "CODE" ProcForUpdate = Output.Offset(0, -1).Value End Select TarBook.Close SaveChanges:=False End Function
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問