把一个子变成一个具有参数的子

新的VBA和我有一个问题，我写了一个子。

这个子文件从各种颜色中取得值，并把这些值放到一个字典中，然后在另一个颜色上打印这个字典。

Sub Unitario() Dim Dict As Object Dim bRiga As Long Dim aRiga As Long Dim cRiga As Long Dim dRiga As Long Dim I As Long Dim MyString As String Dim arr Set Dict = CreateObject("Scripting.Dictionary") Dict.CompareMode = vbTextCompare 'compare without distinction between capitals 'while vbBinaryCompare distinguish between capitals ThisWorkbook.Worksheets("Foglio2").Range("c1").EntireColumn.Clear aRiga = Sheets("Lavoro").Cells(Rows.Count, "M").End(xlUp).Row bRiga = Sheets("Lavoro").Cells(Rows.Count, "N").End(xlUp).Row cRiga = Sheets("Lavoro").Cells(Rows.Count, "O").End(xlUp).Row dRiga = Sheets("Lavoro").Cells(Rows.Count, "P").End(xlUp).Row For I = 4 To aRiga MyString = Sheets("Lavoro").Cells(I, "M") 'to change coloumn i need to change values up there If Not Dict.exists(MyString) Then Dict.Add MyString, MyString End If Next I 'adds coloumns value to dictionary For I = 4 To bRiga MyString = Sheets("Lavoro").Cells(I, "N") 'to change coloumn i need to change values up there If Not Dict.exists(MyString) Then Dict.Add MyString, MyString End If Next I 'adds coloumns value to dictionary For I = 4 To cRiga MyString = Sheets("Lavoro").Cells(I, "O") 'to change coloumn i need to change values up there If Not Dict.exists(MyString) Then Dict.Add MyString, MyString End If Next I 'adds coloumns value to dictionary For I = 4 To dRiga MyString = Sheets("Lavoro").Cells(I, "P") 'to change coloumn i need to change values up there If Not Dict.exists(MyString) Then Dict.Add MyString, MyString End If Next I 'adds coloumns value to dictionary arr = Dict.Items Worksheets("Foglio2").Range("c1").Resize(Dict.Count, 1).Value = Application.Transpose(arr) End Sub 

很明显，这个子不是最优化的，因为我必须手动更改sub中的值，所以我必须在其他范围内使用它。

我想要做的是使一个可以从button的各种范围参数调用一个子，而不必写100次不同的范围相同的macros。 所以我可以简单地写这样的东西，而不是手动修改代码：

  Private sub Commandbutton1_Click Unitario(OutputSheet,OutputCell,InputRange1,InputRange2,..., InputRangeN) End Sub 

所以我只有一个macros的Excel和各种不同的参数button。

你可以帮我吗？

Answer 1

它可以如下所示：

Sub Unitario(strFirstCol as String,strSecondCol as String, strThirdCol as String, strFourthCol as String)

然后你将不得不采取以下部分。

 aRiga = Sheets("Lavoro").Cells(Rows.Count, strFirstCol).End(xlUp).Row bRiga = Sheets("Lavoro").Cells(Rows.Count, strSecondCol).End(xlUp).Row cRiga = Sheets("Lavoro").Cells(Rows.Count, strThirdCol).End(xlUp).Row dRiga = Sheets("Lavoro").Cells(Rows.Count, strFourthCol).End(xlUp).Row 

每个“For循环”内：

 MyString = Sheets("Lavoro").Cells(I, strFirstCol) '\\ Column M MyString = Sheets("Lavoro").Cells(I, strSecondCol) '\\ Column N MyString = Sheets("Lavoro").Cells(I, strThirdCol) '\\ Column O MyString = Sheets("Lavoro").Cells(I, strFourthCol) '\\ Column P 

然后打电话给子

Call Unitario("M","N","O","P")

Answer 2

每当我必须添加参数到一个经常使用的子，或function，我只是添加“选项”的参数。

这样我就不必重新编码每个电话的子。

例

 Public sub test (byval optional addr as string)