VBA:クラスモジュールの引数の減らし方について

　　　　
ChangeDataクラスのShtAndShtプロシージャを用いてShee1の各品番と型式名、品名をSheet2のそれぞれのセルにコピーします

業務に必要なマスタデータを処理する過程でアクセスのフィールドのあるレコードの値をユーザーフォームのテキストボックスやワークシートのセルにコピーするなど、異なるオブジェクト間でデータのコピー・ペーストを行うことが多くなってきたので、それをChangeDataクラスで作ってみました。
データのやり取りをするのは、以下の6パターン(読み込み先と書き込み先)です
アクセスのレコード⇔ワークシートのセル
アクセスのレコード⇔ユーザーフォームのテキストボックス
ワークシートのセル⇔ユーザーフォームのテキストボックス

現在ChangeDataクラス内のそれぞれのプロシージャでforループを回して処理しているのですが、それをクラスモジュールではなく、標準モジュールからforループ処理をすることを考えています。
単純に考えたら、ShtAndSht関数にstartRowとEndRow、LengthOfArray を渡せば良いのかな思ったのですが、そうすると省略不可の引数が7個になってしまうので、これはさすがに多すぎると感じています。

そこで、引数を別の形で処理して減らす方法などありましたら教えていただければ幸いです。
今一つクラスモジュールの使い方をつかめていないので、何卒わかりやすい説明をお願い致します。

標準モジュール(自作クラスモジュールの現状の使用例)

Sub test1()
    
    Dim cd As ChangeData
    Set cd = New ChangeData
    
    Dim makeArr As MakeStrArrForSetObject
    Set makeArr = New MakeStrArrForSetObject
    
    Dim Readlist() As Variant
    Dim Writelist() As Variant
    
    Readlist() = makeArr.ArrPartNum
    Writelist() = makeArr.ArrPartNum
    'このモジュールでループ処理を行いたい
    Call cd.SheAndSht("Sheet1", "Sheet2", Readlist(), Writelist())
    
End Sub

###クラスモジュール１ MakeStrArrForSetObj


Private Const Partnum = "品番"
Private Const Model = "型式名"
Private Const Item = "品名"

Public Function ArrPartNum() As Variant()

    ArrPartNum = Array(PartNum, Model, Item)

End Function

###クラスモジュール２ ChangeData


Public Sub SheAndSht(ByVal TarShtToREAD As String, ByVal TarShtToWRITE As String, ByRef ReadList() As Variant, ByRef WriteList() As Variant)
    
    Dim CntRow As Long
    Dim readobj As Object
    Dim writeobj As Object
    
    Dim StartRow As Long
    Dim EndRow As Long
    Dim LengthOfArray As Long

    Dim reObj As returnObject
    Set reObj = New returnObject
    
    StartRow = 3
    EndRow = 10
    'ここの二重ループをクラスモジュールの外に出し、さらに関数に渡す引数を減らしたい
    For CntRow = StartRow To EndRow

        For LengthOfArray = LBound(ReadList) To UBound(ReadList)
    
    　　　　Set reObj.Cls_ws = Worksheets(TarShtToREAD)
    　　　　Set readobj = reObj.SetObjToRead("CELL", ReadList(), LengthOfArray, CntRow)
            
    　　　　Set reObj.Cls_ws = Worksheets(TarShtToWRITE)
    　　　　Set writeobj = reObj.SetObjToWrite("CELL", WriteList(), LengthOfArray, CntRow)
    
    　　　　writeobj.Value = readobj.Value
    
        Next LengthOfArray

    Next CntRow
    
End Sub

###クラスモジュール３ returnObject

・クラス変数
Public Cls_ws As Worksheet
Public Cls_ADORes As ADODB.Recordset
Public Cls_Frm As UserForm

Public Function SetObjToRead(ByVal strTarObj As String, ByRef Cls_strArrForSetObj() As Variant, ByVal TarCol As Long, Optional TarRowForCell As Long = 1) As Object
    'データを読み込む(コピーする)オブジェクトを選択
    Select Case strTarObj

        Case "CELL"
            
            Set SetObjToRead = ObjCell(Cls_strArrForSetObj(TarCol), TarRowForCell)

        Case "FIELD"

            Set SetObjToRead = ObjField(Cls_strArrForSetObj(TarCol))

        Case "CONTROL"

            Set SetObjToRead = ObjControl(Cls_strArrForSetObj(TarCol))

    End Select

End Function

Public Function SetObjToWrite(ByVal strTarObj As String, ByRef Cls_strArrForSetObj() As Variant, ByVal TarCol As Long, Optional TarRowForCell As Long = 1) As Object
    'データを書き込む(ペーストする)オブジェクトを選択
    Select Case strTarObj

        Case "CELL"
            
            Set SetObjToWrite = ObjCell(Cls_strArrForSetObj(TarCol), TarRowForCell)

        Case "FIELD"

            Set SetObjToWrite = ObjField(Cls_strArrForSetObj(TarCol))

        Case "CONTROL"

            Set SetObjToWrite = ObjControl(Cls_strArrForSetObj(TarCol))

    End Select

End Function

Private Function ObjCell(ByRef Cls_strForSetObj As Variant, ByVal TarRow As Long) As Range

    Set ObjCell = Cls_ws.Cells(TarRow, ColSlctByTitle(Cls_strForSetObj, Cls_ws))

End Function

#修正
追加の返信をいただく前に標準モジュールにしてしまいました。申し訳ないです。

使用例：ワークシート→ユーザーフォーム間のデータのやりとり

アクティブシートのデータを取得したい行を「行番号」のテキストボックスに入力してから、「コピー元決定」ボタンを押すとcmdC_DecideParts_Clickが動きます
データのやりとりを行うオブジェクトはSetObjToRead関数とSetObjToWrite関数で決めており、どのオブジェクトのどの要素をやりとりの対象とするのかを文字列として渡すことで目的のオブジェクトを決めています。
(例：データを読み込みたい(値をコピーしたい)オブジェクトをアクティブシートの7行目にある品番列のRangeオブジェクトにする場合)
→strTarObjName="CELL"、TarRowForCell=7,strTarElement="品番",TarObj=ActivesheetをSetObjToRead関数に引数として渡す
セルをデータのやり取りの対象にしたい場合は単純に列番号を渡すと列の順番を変更できないので、さらにcolslctbytitle関数に列名を文字列として渡して、渡した文字列とシートの列名が一致したらそのときの列番号をcolslctbytitle関数の返り値としています

ReadArray(),WriteArray()ではSetObjToRead関数とSetObjToWrite関数に渡すための文字列を決めています

現状はShtToFrm関数のように(データの読み込み先：Worksheet)To(データの書き込み先:UserForm)として関数の名前を付けていますが、6パターン文の関数(ShtToFrm,FrmToSht,ShtToAccessDB,AccessDBToSht,FrmToAccessDB,AccessDBToFrm)
(データの書き込み先がAccessDBの場合は新規追加と更新もあるので、さらに関数が増えそう)
を作るのではなく、2,3つの関数にまとめられたらと考えています。

ユーザーフォームのモジュール(FrmCopyContentsInfoOfParts)

Private Sub cmdC_DecideParts_Click()
    
    Dim TarRow As Integer
    TarRow = Me.txtRowNum.Value

    Dim ReadArray() As Variant
    Dim WriteArray() As Variant
    
    '配列の要素はそれぞれ対応していなければならない(e.g:品番⇔txtC_PartNum)
    ReadArray() = Array("品番", "図番", "図番改定", "品名", "型式名", "アキクラコード", "メーカー名", "メーカーコード", "仕入先", "仕入先コード", "標準原価単価", "標準発注単価", _
                        "ロット発注", "ロット単位数", "部品_在庫小数桁", "在庫用発注_棚卸変換値", "標準発注LT", "製番製品No_ロットNo", _
                        "部品単位", "発注単位", "品番分類", "在庫分類", "発注手配", "引当手配", "品番備考")
    WriteArray() = Array("txtC_PartNum", "txtC_ChartNum", "txtC_ChartNumRev", "txtC_Item", "txtC_Model", "txtC_AkikuraCode", "txtC_maker", "txtC_MakerCode", "txtC_Vendor", "txtC_VendorCode", "txtC_Price", "txtC_OrderPrice", _
                        "txtC_Lot", "txtC_LotQty", "txtC_Digit", "txtC_ConversionValue", "txtC_LT", "txtC_LotNo", _
                        "txtC_PartsUnit", "txtC_OrderUnit", "txtC_PartNumClassCode", "txtC_StockClassCode", "txtC_OrderArrgtCode", "txtC_AllocArrgtCode", "txtC_Remark")
    Call ShtToFrm(ReadArray(), WriteArray(), TarRow)
    
End Sub

以下、標準モジュール

Public Sub ShtToFrm(ByRef strArrayToRead() As Variant, ByRef strArrayToWrite() As Variant, ByVal TarRow As Long)
    
    If UBound(strArrayToRead) <> UBound(strArrayToWrite) Then
        
        MsgBox "読み込み先の配列の要素数と書き込み先の配列の要素数が違います" & vbCrLf & "処理を中止します"
        Exit Sub
        
    End If

    Dim StartRow As Long
    Dim LengthOfArray As Long
    
    Dim ReadObj As Object
    Dim WriteObj As Object
    
    For LengthOfArray = LBound(strArrayToRead) To UBound(strArrayToRead)

        Set ReadObj = SetObjToRead("CELL", ActiveSheet, strArrayToRead(LengthOfArray), TarRow)
        Set WriteObj = SetObjToWrite("CONTROL", FrmCopyContentsInfoOfParts, strArrayToWrite(LengthOfArray))
    
        WriteObj.Value = ReadObj.Value

    Next LengthOfArray
    
End Sub

前回ではSetObjToReadやSetObjToWriteに配列を渡していたので、それを配列内の文字列を直接渡すようにしたのですが、こうしてみるとShtToFrmにも配列で渡す必要なかったですね
そうすれば、forループを関数の外で処理できそうです

Option Explicit

Public Function SetObjToRead(ByVal strTarObjName As String, ByVal TarObj As Object, ByVal strTarElement As String, Optional TarRowForCell As Long = 1) As Object
    'データを読み込む(コピーする)オブジェクトを選択
    
    On Error GoTo Err
    
    Select Case strTarObjName

        Case "CELL"
            
            Set SetObjToRead = TarObj.Cells(TarRowForCell, ColSlctByTitle(strTarElement, TarObj))
            
        Case "FIELD"
            
            Set SetObjToRead = TarObj.Fields(strTarElement)
                
        Case "CONTROL"
            
            Set SetObjToRead = TarObj.Controls(strTarElement)
            
    End Select
    
    Exit Function
    
Err:
    Call ErrHndl(Err.Number, Err.Description)
    
End Function

Public Function SetObjToWrite(ByVal strTarObjName As String, ByVal TarObj As Object, ByVal strTarElement As String, Optional TarRowForCell As Long = 1) As Object
    'データを書き込む(ペーストする)オブジェクトを選択
    
    On Error GoTo Err
    
    Select Case strTarObjName

        Case "CELL"
            
            Set SetObjToWrite = TarObj.Cells(TarRowForCell, ColSlctByTitle(strTarElement, TarObj))
            
        Case "FIELD"
            
            Set SetObjToWrite = TarObj.Fields(strTarElement)
                
        Case "CONTROL"
            
            Set SetObjToWrite = TarObj.Controls(strTarElement)
            
    End Select
    
    Exit Function
    
Err:
    Call ErrHndl(Err.Number, Err.Description)
    
End Function

Private Sub ErrHndl(ByVal ErrNum As Long, ByVal ErrDiscription As Variant)
    
    Select Case ErrNum
    
        Case Else
            
            MsgBox "エラー番号:" & Err.Number & vbCrLf & "エラーの種類:" & ErrDiscription
            
    End Select
    
End Sub

Public Const StartRow = 5

Public Function ColSlctByTitle(ByVal Title As String, ByVal ws As Worksheet, Optional ByVal DefaultRow As Integer = StartRow) As Integer
    
    Dim CountCol As Integer
    Dim titleRow As Integer
    Dim MaxCol As Integer
    
    titleRow = DefaultRow   ' タイトル行番号
    
    With ws
        MaxCol = .Cells(DefaultRow, .Columns.Count).End(xlToLeft).Column
        For CountCol = 1 To MaxCol
            If .Cells(titleRow, CountCol).Text() = Title Then
                ColSlctByTitle = CountCol
                Exit Function      ' 正常終了
            End If
        Next
    End With
    
    'エラー終了
    Err.Description = ws.Name & "のタイトル行に指定文字列( " + Title + " ) が見つかりませんでした"
    Err.Raise (60000)
    MsgBox (Err.Description)
    
End Function

Youbun

2019/10/29 05:55 編集

ぱっと見で思ったのですが、・そもそも「ChangeData」をクラスにする必要はあるのでしょうか？・ReadList()とWriteList()の中身が変わる可能性はありますか？　テスト関数では常に同じ内容が入ってるっぽいのですが。。。・ReadList()とWriteList()を参照渡しで渡す必要性はありますか？　ないならまとめれる気がします。

hachi3156

2019/10/29 10:42

Youbun様返信していただきありがとうございます。・そもそも「ChangeData」をクラスにする必要はあるのでしょうか？ →オブジェクト指向を使うとプログラムを再利用や変更がしやすく、VBAではクラスモジュールがそれに該当すると聞いて、実際コードこそ全く同じではないものの、似たような処理を行っていたためそれらの共通する部分をまとめて使いまわせないかと考えて今回のようなものを作ってみた次第です・ReadList()とWriteList()の中身が変わる可能性はありますか？ →すみません、例が悪かったです。シート間のデータのやりとりの場合は両方とも同じになりますが、ReadListやWritelist内の文字列を使ってオブジェクトを返すようにしているので、シートとユーザーフォームやユーザーフォームやフィールドとのやりとりの場合は変わってきます・ReadList()とWriteList()を参照渡しで渡す必要性はありますか？ →よくよく考えたら必要なさそうです教えていただいたサイトを参考に今一度クラスについて勉強いたします。

Youbun

2019/10/30 10:00

・適切なデータ例に修正してくれたら何がしたいのか分かりやすくなる・上げているソースコードに使ってない関数があり、崩していいのか分からないので　説明を加えてくれると分かりやすい・ブックをまたいでやり取りするのか？上記質問を質問に追記していただけると回答しやすいと思います

行動規範の内容に同意します

回答1件

ベストアンサー

こんな感じで省略できる引数を探してください
という事で質問の目的はあってますか？

今回の例を見る限りでは、
関数内で変数が完結しているので
クラスにする必要はないように感じました。
クラスは知ってるけれど使い道がわからないから解説
このサイトを見たらクラスをどんなタイミングで使うか参考になると思います。

標準モジュール

vb
1Sub test1()
2
3    Dim cd As ChangeData
4    Set cd = New ChangeData
5
6    Dim makeArr As MakeStrArrForSetObject
7    Set makeArr = New MakeStrArrForSetObject
8    Dim CopyKey() As Variant
9    CopyKey() = makeArr.ArrPartNum
10    
11    'このモジュールでループ処理を行いたい　※一応見やすい様に関数のままにしてます
12    Call SheAndSht("Sheet1", "Sheet2", CopyKey())
13
14End Sub
15
16'クラスを分解、一応見やすい様に関数のままにしてます
17Public Sub SheAndSht(ByVal TarShtToREAD As String, ByVal TarShtToWRITE As String, ByRef CopyKey() As Variant)
18
19    Dim CntRow As Long
20    Dim readobj As Object
21    Dim writeobj As Object
22
23    Dim StartRow As Long
24    Dim EndRow As Long
25    Dim LengthOfArray As Long
26
27    Dim reObj As returnObject
28    Set reObj = New returnObject
29
30    StartRow = 3
31    EndRow = 10
32    'ここの二重ループをクラスモジュールの外に出し、さらに関数に渡す引数を減らしたい
33    For CntRow = StartRow To EndRow
34
35        For LengthOfArray = LBound(ReadList) To UBound(ReadList)
36
37            Set reObj.Cls_ws = Worksheets(TarShtToREAD)
38            Set readobj = reObj.SetCopyPasteRange("CELL", CopyKey(LengthOfArray), CntRow)
39
40            Set reObj.Cls_ws = Worksheets(TarShtToWRITE)
41            Set writeobj = reObj.SetCopyPasteRange("CELL", CopyKey(LengthOfArray), CntRow)
42
43            writeobj.Value = readobj.Value
44
45        Next LengthOfArray
46
47    Next CntRow
48
49End Sub
50
51Public Sub ReadDBData(ByVal TarObjToWRITE As String, ByRef ReadList() As Variant, ByRef WriteList() As Variant, ByVal strSQL As String)
52
53    Dim CntRow As Long
54    Dim readobj As Object
55    Dim writeobj As Object
56    Dim LengthOfArray As Long
57    Dim StartRow As Long
58    Dim EndRow As Long
59
60    Dim ADOCon As ADODB.Connection
61    Dim ADORes As ADODB.Recordset
62
63    Set ADOCon = initDb(ADODB_NAME, ADODB_PASS)
64    Set ADORes = New ADODB.Recordset
65
66    ADORes.Open strSQL, ADOCon
67
68    Dim reObj As returnObject
69    Set reObj = New returnObject
70
71    '----標準モジュール記載
72    Set reObj.Cls_ADORes = CreateObject("ADODB.recordset")
73    Set reObj.Cls_Frm = UserForm1
74    '----
75
76    StartRow = 3
77    EndRow = 10
78
79    For CntRow = StartRow To EndRow
80        'リストの要素数
81        For LengthOfArray = LBound(ReadList) To UBound(ReadList)
82
83            Set readobj = reObj.SetObjTo("FIELD", ReadList(LengthOfArray), CntRow)
84            Set writeobj = reObj.SetObjTo(TarObjToWRITE, WriteList(LengthOfArray), CntRow)
85
86            writeobj.Value = readobj.Value
87
88        Next LengthOfArray
89
90    Next CntRow
91
92End Sub
93
94Public Function ColSlctByTitle(ByVal Title As String, ByVal ws As Worksheet, Optional ByVal DefaultRow As Integer = StartRow) As Integer
95
96    Dim CountCol As Integer
97    Dim titleRow As Integer
98    Dim MaxCol As Integer
99
100    titleRow = DefaultRow   ' タイトル行番号
101
102    With ws
103        MaxCol = .Cells(DefaultRow, .Columns.Count).End(xlToLeft).Column
104        For CountCol = 1 To MaxCol
105            If .Cells(titleRow, CountCol).Text() = Title Then
106                ColSlctByTitle = CountCol
107                Exit Function      ' 正常終了
108            End If
109        Next
110    End With
111
112    'エラー終了
113    Err.Description = ws.Name & "のタイトル行に指定文字列( " + Title + " ) が見つかりませんでした"
114    Err.Raise (60000)
115    MsgBox (Err.Description)
116
117End Function
118
119Public Function initDb(ByVal FileName As String, ByVal FilePass As String) As ADODB.Connection
120
121    Dim ConnectionString As String          '接続文字列
122    Dim DbFilePass As String                'データベースファイルのパス
123    Dim DbFileName As String                'データベースファイルの名前
124
125    Dim ADOCon As ADODB.Connection          'データベース接続オブジェクト
126    Dim strCon As String
127
128    '接続文字列作成
129    ConnectionString = "Microsoft.ACE.OLEDB.12.0"
130    DbFileName = FileName & ".accdb"
131
132    Set ADOCon = New ADODB.Connection
133
134    ' 接続文字列を作成する
135    strCon = "Provider=" & ConnectionString & ";" & "Data Source=" & FilePass & DbFileName & ";"
136
137    '接続する
138    ADOCon.Open strCon
139
140    Set initDb = ADOCon
141
142End Function

クラスモジュール３ returnObject

vb
1'このクラスも、要らないと思う※「Cls_Frm」がどうなるのか分からないので分解しませんでした
2'クラス変数
3Public Cls_ws As Worksheet
4Public Cls_ADORes As ADODB.Recordset
5Public Cls_Frm As UserForm
6
7'コピー先もペースト先も同じ関数で行ける？
8Public Function SetCopyPasteRange(ByVal strTarObj As String, ByVal Title As String, Optional TarRowForCell As Long = 1) As Object
9    Select Case strTarObj
10        Case "CELL"
11            Set SetCopyPasteRange = ObjCell(Title, TarRowForCell)
12        Case "FIELD"
13            Set SetCopyPasteRange = ObjField(Title)
14        Case "CONTROL"
15            Set SetCopyPasteRange = ObjControl(Title)
16    End Select
17End Function
18
19Private Function ObjCell(ByVal Title As String, ByVal TarRow As Long) As Range
20    Set ObjCell = Cls_ws.Cells(TarRow, ColSlctByTitle(Title, Cls_ws))
21End Function