VBA编写函数及返回值

Question

我正在尝试调用另一个子例程中的子例程并希望返回一些值。但它似乎没有返回任何值。我该如何将其写成一个函数？代码如下:

Sub tickersymbolchange()

 Dim RSTA_ISIN, RSTA_Currency, RSTA_Ticker As String

For Each rng In r

         ticker_wo_equity = Replace(rng.Value, " Equity", "")
         Exchangecode = Right(ticker_wo_equity, 2)

         Select Case Exchangecode
            Case "PO", "L3", "B3", "S2", "TQ", "SS"

                'MsgBox "I am in PO"

                Call getRSTA_POL3B3S2TQSSIXEB(ticker_wo_equity, RSTA_ISIN, RSTA_Currency, RSTA_Ticker)

                'Get ISIN from Rsta
                If IsEmpty(RSTA_ISIN) Then
                     rng.Offset(0, 11) = "N/A"
                Else
                     rng.Offset(0, 11) = RSTA_ISIN
                End If


                'Get Currency from Rsta
                If IsEmpty(RSTA_Currency) Then
                    rng.Offset(0, 12) = "N/A"
                Else
                    rng.Offset(0, 12) = RSTA_Currency
                End If
End select

End Sub

---

Sub getRSTA_POL3B3S2TQSSIXEB(ticker, Optional ByVal getISIN As String, Optional ByVal getCurrency As String, Optional ByVal getTicker As String, Optional ByVal getUS As String, Optional ByVal getTickerTicker_IBEX As String, Optional ByVal getPriceCode_GR As String)

    BBs.Send ticker & "<Equity> RSTA"
    BBs.Go
    'Application.Wait (Now + TimeValue("0:00:01"))
    'Sleep 1000

    BBs.CopyScreen

    getISIN = BBs.GetTextField(7, 2, 13)
    getCurrency = BBs.GetTextField(7, 15, 4)
    getTicker = BBs.GetTextField(7, 20, 6)
    getUS = BBs.GetTextField(7, 11, 9)
    getTickerTicker_IBEX = BBs.GetTextField(7, 2, 7)
    getPriceCode_GR = BBs.GetTextField(7, 2, 7)

End Sub

所以在这里我尝试将 RSTA_ISIN 赋予函数 getRSTA_POL...，然后该函数应将 getISIN 的值分配给 RSTA_ISIN，但是 RSTA_ISIN 和所有其他参数始终为空。

Answer 1

首先，您的代码对子例程使用Call，您可以使用它，但它实际上避免了函数的任何输出!

其次，如果您想影响过程或函数内部参数的值，则需要使用 ByRef 而不是 ByVal。 ByVal 将创建输入参数的副本，但不会影响初始变量!

最后，您需要将第二个 Sub 转换为 Function 并定义输出类型(这里我将其设置为 String)，然后将函数输出分配给变量，如下所示:

Public Function test_Function() As Integer
    test = 1
End Function
Sub Test()
    Dim Result as Integer
    Result = test_Function
    MsgBox Result 
End Sub

这是您修改后的代码:

Sub tickersymbolchange()
Dim RSTA_ISIN As String, RSTA_Currency As String, RSTA_Ticker As String
For Each Rng In r
    ticker_wo_equity = Replace(Rng.Value, " Equity", "")
    Exchangecode = Right(ticker_wo_equity, 2)

    Select Case Exchangecode
       Case "PO", "L3", "B3", "S2", "TQ", "SS"
           RSTA_ISIN = getRSTA_POL3B3S2TQSSIXEB(ticker_wo_equity, RSTA_ISIN, RSTA_Currency, RSTA_Ticker)
           'Get ISIN from Rsta
           If IsEmpty(RSTA_ISIN) Then
                Rng.Offset(0, 11) = "N/A"
           Else
                Rng.Offset(0, 11) = RSTA_ISIN
           End If
           'Get Currency from Rsta
           If IsEmpty(RSTA_Currency) Then
               Rng.Offset(0, 12) = "N/A"
           Else
               Rng.Offset(0, 12) = RSTA_Currency
           End If
    End Select
Next Rng
End Sub

Function getRSTA_POL3B3S2TQSSIXEB(ticker, Optional ByRef getISIN As String, _
                            Optional ByRef getCurrency As String, _
                            Optional ByRef getTicker As String, _
                            Optional ByRef getUS As String, _
                            Optional ByRef getTickerTicker_IBEX As String, _
                            Optional ByRef getPriceCode_GR As String) As String
    BBs.Send ticker & "<Equity> RSTA"
    BBs.Go
    'Sleep 1000
    BBs.CopyScreen

    getISIN = BBs.GetTextField(7, 2, 13)
    getCurrency = BBs.GetTextField(7, 15, 4)
    getTicker = BBs.GetTextField(7, 20, 6)
    getUS = BBs.GetTextField(7, 11, 9)
    getTickerTicker_IBEX = BBs.GetTextField(7, 2, 7)
    getPriceCode_GR = BBs.GetTextField(7, 2, 7)

getRSTA_POL3B3S2TQSSIXEB = getISIN
End Function