将宏传输到 UDF

Posted 2023-02-22

【中文标题】将宏传输到 UDF

【英文标题】：Transfer macro to UDF

【发布时间】：2022-01-19 17:20:02

【问题描述】：

我想将下面的宏转移到 UDF，但我不知道如何。

我想要一个 udf，我在其中选择 Findstring 并将其返回到放置 udf 的单元格中。

有人可以帮我吗？

Sub Find_pipe()
    Dim Findstring As String
    Dim Location As String
    Dim Rng As Range
    
    Sub Find_First()
    Dim Findstring As String
    Dim Rng As Range
    Findstring = InputBox("vul naam van leiding in")
    
    If Trim(Findstring) <> "" Then
        With Sheets("scenario 1V2").Range("A1:BP150")
            Set Rng = .Find(What:=Findstring, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                Application.Goto Rng.Offset(1), True
                Application.Goto ThisWorkbook.Worksheets("D en L berekening").Range("A1"), True
                ThisWorkbook.Worksheets("D en L berekening").Range("U10").Value = Rng.Offset(1).Value
            Else
                MsgBox "Nothing found"
            End If
        End With
    End If
End Sub

【参考方案1】：

试试这个：

Function FindPipe(Findstring As String)
    Application.Volatile 'You need this if your UDF needs to update after changes in
                         '   the search range
    Dim f As Range
    If Trim(Findstring) <> "" Then
        With ThisWorkbook.Sheets("scenario 1V2").Range("A1:BP150")
            Set f = .Find(What:=Findstring, _
                    After:=.Cells(.Cells.Count), _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
        End With
        If Not f Is Nothing Then
            FindPipe = f.Offset(1).Value
        Else
            FindPipe = "Not found"
        End If
    Else
        FindPipe = ""
    End If
End Function

请注意，要搜索的范围在 UDF 中是硬编码的，因此如果搜索范围更新，Excel 不知道要重新计算您的 UDF。我添加了 Application.Volatile 来解决这个问题，但如果您有很多指向该 UDF 的公式，它可能会减慢您的工作簿。