简体   繁体   English

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

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

I've had a look around for an answer, but could only find things relating to normal Excel functions. 我一直在寻找答案,但只能找到与普通Excel功能有关的内容。 The situation: I have a user defined function (UDF) written up in Excel. 情况:我有一个用Excel编写的用户定义函数(UDF)。 I'll provide the code, although I don't think it is particularly important. 我将提供代码,尽管我认为它不是特别重要。 I would like to prevent the UDF from calculating at certain times (as it is across a few thousand cells, and needs to be turned off when I'm working on other things in the sheet to prevent long waiting times). 我想防止UDF在某些时间进行计算(因为它跨越了数千个单元格,并且在处理工作表中的其他内容时需要将其关闭,以防止等待很长时间)。

Currently I achieve this with cell B1 containing (as the output of a basic formula) "Pause" - and an If statement at the start of my UDF checks for this and exits the function if pause is entered. 目前,我使用包含(作为基本公式的输出)“ 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

Exiting returns a 0 in each cell. 退出将在每个单元格中返回0。 However, from earlier running of the code, these cells all already contain values. 但是,从代码的较早运行开始,这些单元格都已经包含值。 How can I keep these values the same when I pause, instead of having them switched to zeros? 暂停时如何保持这些值不变,而不是将它们切换为零? I think an approach could be to temporarily save each cell value at an earlier stage in the UDF, then to call it if B1 does indeed contain 'pause' - but I'm not sure when VBA clears a cell's contents - and I'm also relatively new to VBA so wouldn't know how to anyway! 我认为一种方法可能是在UDF的早期阶段临时保存每个单元格值,然后在B1确实包含“暂停”时调用它-但我不确定VBA何时清除单元格的内容-我VBA也相对较新,所以无论如何都不知道!

Thanks 谢谢

UPDATE: The idea here is to hugely simplify the UDF under the pause circumstance so it takes next to no time to calculate, or to pause the UDF entirely. 更新:这里的想法是在暂停情况下极大地简化UDF,因此几乎不需要时间来计算或完全暂停UDF。 I would like to preserve all other workbook functionality, so Manual calculation is not an option (+ when I save/open the UDFs are calculated regardless, it would be great to leave the pause in when I save (as in my own attempt at a solution) so that this calculation doesn't take place upon opening/closing/saving the worksheet) 我想保留所有其他工作簿功能,因此不能选择“手动计算”(无论如何,在保存/打开UDF时都会进行计算,保存时暂停会很不错(就像我自己尝试的解决方案),以便在打开/关闭/保存工作表时不会进行此计算)

you could try this: 您可以尝试以下方法:

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

with the caveat that it has to be enhanced should your function be called form different worksheets 需要警告的一点是,应该在不同的工作表中调用您的函数

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM