将子变为带有参数

时间:2017-11-02 09:48:51

标签: excel excel-vba vba

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
很明显,这个子没有被优化,因为我必须随时手动更改子中的值,我必须将它与其他范围一起使用。

我想要做的是创建一个可以通过按钮使用各种范围参数调用的子类,而不必将具有不同范围的相同宏写入100次。 所以我可以简单地写这样的东西,而不是手动修改代码:

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

这样我在excel上只有1个宏,而且各个按钮的参数不同。

你可以帮帮我吗?

2 个答案:

答案 0 :(得分:2)

可能如下所示:

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")

答案 1 :(得分:0)

每当我必须为经常使用的子或函数添加参数时,我只需用'optionaĺ'添加参数。

这样我就不必重新编码每次调用子。

实施例

Public sub test (byval optional addr as string)