Q&A
UserForms.Addは私も「ん？」と思ったのですが、調べてみるとかつてはMS公式情報としてあったようですね。
実際に動かしてみるときちんと値も取れていました。
http://officetanaka.net/excel/vba/tips/tips103.htm
※MSのページは現在削除されているようです
前提・実現したいこと
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/ツールのバージョンなど）
回答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枚表示されていることが分かります。
確認出来たら、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
総合スコア34362
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を使ってFrmUpdateのbtnFindPart_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)
.抜け
以下のRows・Columnsの前に.が抜けています。
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
総合スコア2166
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
> プログラムの構造としては～
私個人の考えではありますが、処理はこま切れにして、共通で使える処理と、共通処理を呼び出す条件分岐処理の形にしていきたいです。
---
コードをざっくり見た感じですが、メーカーとベンダーで異なる点は
・開くブックのパス
・シートの名前
の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
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
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2019/07/22 23:36
2019/07/23 01:21
2019/07/23 01:36
2019/07/23 01:40
2019/07/23 02:35