簡體   English   中英

Excel VBA:如果…,則不更改單元格值就退出UDF

[英]Excel VBA: If … then exit UDF without changing cell value

我一直在尋找答案,但只能找到與普通Excel功能有關的內容。 情況:我有一個用Excel編寫的用戶定義函數(UDF)。 我將提供代碼,盡管我認為它不是特別重要。 我想防止UDF在某些時間進行計算(因為它跨越了數千個單元格,並且在處理工作表中的其他內容時需要將其關閉,以防止等待很長時間)。

目前,我使用包含(作為基本公式的輸出)“ Pause”的單元格B1來實現此目的-UDF開頭的If語句對此進行檢查,如果輸入了暫停,則退出該函數。

Public Function SIMILARITY(ByVal String1 As String, _
    ByVal String2 As String, _
    Optional ByRef RetMatch As String, _
    Optional min_match = 1) As Single
Dim b1() As Byte, b2() As Byte
Dim lngLen1 As Long, lngLen2 As Long
Dim lngResult As Long


If UCase(ActiveSheet.Range("B1").Value) = "PAUSE" Then
    Exit Function

ElseIf UCase(String1) = UCase(String2) Then
    SIMILARITY = 1

Else:
    lngLen1 = Len(String1)
    lngLen2 = Len(String2)
    If (lngLen1 = 0) Or (lngLen2 = 0) Then
        SIMILARITY = 0
    Else:
        b1() = StrConv(UCase(String1), vbFromUnicode)
        b2() = StrConv(UCase(String2), vbFromUnicode)
        lngResult = Similarity_sub(0, lngLen1 - 1, _
        0, lngLen2 - 1, _
        b1, b2, _
        String1, _
        RetMatch, _
        min_match)
        Erase b1
        Erase b2
        If lngLen1 >= lngLen2 Then
            SIMILARITY = lngResult / lngLen1
        Else
            SIMILARITY = lngResult / lngLen2
        End If
    End If
End If

End Function

Private Function Similarity_sub(ByVal start1 As Long, ByVal end1 As Long, _
                                ByVal start2 As Long, ByVal end2 As Long, _
                                ByRef b1() As Byte, ByRef b2() As Byte, _
                                ByVal FirstString As String, _
                                ByRef RetMatch As String, _
                                ByVal min_match As Long, _
                                Optional recur_level As Integer = 0) As Long
'* CALLED BY: Similarity *(RECURSIVE)

Dim lngCurr1 As Long, lngCurr2 As Long
Dim lngMatchAt1 As Long, lngMatchAt2 As Long
Dim I As Long
Dim lngLongestMatch As Long, lngLocalLongestMatch As Long
Dim strRetMatch1 As String, strRetMatch2 As String

If (start1 > end1) Or (start1 < 0) Or (end1 - start1 + 1 < min_match) _
Or (start2 > end2) Or (start2 < 0) Or (end2 - start2 + 1 < min_match) Then
    Exit Function '(exit if start/end is out of string, or length is too short)
End If

For lngCurr1 = start1 To end1
    For lngCurr2 = start2 To end2
        I = 0
        Do Until b1(lngCurr1 + I) <> b2(lngCurr2 + I)
            I = I + 1
            If I > lngLongestMatch Then
                lngMatchAt1 = lngCurr1
                lngMatchAt2 = lngCurr2
                lngLongestMatch = I
            End If
            If (lngCurr1 + I) > end1 Or (lngCurr2 + I) > end2 Then Exit Do
        Loop
    Next lngCurr2
Next lngCurr1

If lngLongestMatch < min_match Then Exit Function

lngLocalLongestMatch = lngLongestMatch
RetMatch = ""

lngLongestMatch = lngLongestMatch _
+ Similarity_sub(start1, lngMatchAt1 - 1, _
start2, lngMatchAt2 - 1, _
b1, b2, _
FirstString, _
strRetMatch1, _
min_match, _
recur_level + 1)
If strRetMatch1 <> "" Then
    RetMatch = RetMatch & strRetMatch1 & "*"
Else
    RetMatch = RetMatch & IIf(recur_level = 0 _
    And lngLocalLongestMatch > 0 _
    And (lngMatchAt1 > 1 Or lngMatchAt2 > 1) _
    , "*", "")
End If


RetMatch = RetMatch & Mid$(FirstString, lngMatchAt1 + 1, lngLocalLongestMatch)


lngLongestMatch = lngLongestMatch _
+ Similarity_sub(lngMatchAt1 + lngLocalLongestMatch, end1, _
lngMatchAt2 + lngLocalLongestMatch, end2, _
b1, b2, _
FirstString, _
strRetMatch2, _
min_match, _
recur_level + 1)

If strRetMatch2 <> "" Then
    RetMatch = RetMatch & "*" & strRetMatch2
Else
    RetMatch = RetMatch & IIf(recur_level = 0 _
    And lngLocalLongestMatch > 0 _
    And ((lngMatchAt1 + lngLocalLongestMatch < end1) _
    Or (lngMatchAt2 + lngLocalLongestMatch < end2)) _
    , "*", "")
End If

Similarity_sub = lngLongestMatch

End Function

退出將在每個單元格中返回0。 但是,從代碼的較早運行開始,這些單元格都已經包含值。 暫停時如何保持這些值不變,而不是將它們切換為零? 我認為一種方法可能是在UDF的早期階段臨時保存每個單元格值,然后在B1確實包含“暫停”時調用它-但我不確定VBA何時清除單元格的內容-我VBA也相對較新,所以無論如何都不知道!

謝謝

更新:這里的想法是在暫停情況下極大地簡化UDF,因此幾乎不需要時間來計算或完全暫停UDF。 我想保留所有其他工作簿功能,因此不能選擇“手動計算”(無論如何,在保存/打開UDF時都會進行計算,保存時暫停會很不錯(就像我自己嘗試的解決方案),以便在打開/關閉/保存工作表時不會進行此計算)

您可以嘗試以下方法:

Function SIMILARITY(ByVal String1 As String, _
                    ByVal String2 As String, _
                    Optional ByRef RetMatch As String, _
                    Optional min_match = 1) As Single

    If UCase(ActiveSheet.Range("B1").Value) = "PAUSE" Then
        SIMILARITY = Application.Caller.Text '<--| "confirm" actual cell value
    Else

        'here goes you "real" function code

    End If

End Function

需要警告的一點是,應該在不同的工作表中調用您的函數

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM