VBA将变量传递给函数

时间:2017-04-06 13:34:22

标签: excel vba excel-vba parameter-passing

最终目标:我正在尝试编辑从大写到正确(大写)的列中的现有文本 - 有一个例外,如果单词后跟一个连字符它将保持小写。我正在输出2列。

我的第一个sub需要将我的活动单元格传递给应用格式化的函数(函数已经过测试并且有效)。

我不知道如何做这项工作。

Option Explicit

Dim txt As String
Dim i As Long
Dim strTest As String
Dim strArray() As String
Dim lCaseOn As Boolean
Dim firstRow As Long, startIt As Long
Dim thisCell As Range
Dim lastRow As Long

Sub throughCols()

Dim thisCell As Range

dataRange
startIt = firstRow + 1

For i = startIt To lastRow
    ' No idea how to pass my cell I am picking up through to my function
    thisCell = Sheets("Names").Select: Range("B" & i).Select
    arrayManip (thisCell)
    'I need to pass this ActiveCell to arrayManip- not sure how
Next i

End Sub

'====================================================================

Function arrayManip(thisCell)

    'Hard coded source cell for testing
    ' Now trying to itterate through column

    ' clear out all data
    Erase strArray
    txt = ""

    'set default case
    lCaseOn = False

    ' string into an array using a " " separator
    strTest = WorksheetFunction.Proper(ActiveCell.Value)
    strTest = Replace(strTest, "-", " - ")
    strArray = Split(strTest, " ")

    ' itterate through array looking to make text foll
    For i = LBound(strArray) To UBound(strArray)
        If strArray(i) = "-" Then
            lCaseOn = True
            GoTo NextIteration
        End If

        If lCaseOn Then
            strArray(i) = LCase(strArray(i))
            lCaseOn = False
NextIteration:
        End If

        ' loop through the array and build up a text string for output to the message box
        txt = txt & strArray(i) & " "

        ' remove the space
        txt = Trim(Replace(txt, " - ", "-"))
        ActiveCell.Offset(0, 2).Select: ActiveCell.Value = txt
    Next i

' MsgBox txt

End Function

'====================================================================

Sub dataRange()

With Sheets("Names").Columns("B")
    If WorksheetFunction.CountA(.Cells) = 0 Then '<--| if no data whatever
        MsgBox "Sorry: no data"
    Else
        With .SpecialCells(xlCellTypeConstants) '<--| reference its cells with constant (i.e, not derived from formulas) values)
            firstRow = .Areas(1).Row
            lastRow = .Areas(.Areas.Count).Cells(.Areas(.Areas.Count).Rows.Count).Row
        End With
        ' MsgBox "the first row is " & firstRow
        ' MsgBox "last row is " & lastRow
    End If
End With

End Sub

1 个答案:

答案 0 :(得分:0)

而不是:

thisCell = Sheets("Names").Select: Range("B" & i).Select

执行:

'## Use the SET keyword to assign an object variable
Set thisCell = Sheets("Names").Range("B" & i)

此外,不是依赖于函数体中的ActiveCell,而是更改为:

strTest = WorksheetFunction.Proper(thisCell.Value)

然后调用你的函数:

Call arrayManip(thisCell)

如果您的功能没有向调用者返回值,则可能应该是Sub。将其更改为Sub,上述Call语句仍应有效。

另见:

How to make Excel VBA variables available to multiple macros?