Excel VBA:如果…则在不更改单元格值的情况下退出UDF

我已经看了一个答案,但只能find有关正常的Excel函数的东西。 情况:我有用Excel定义的用户定义函数(UDF)。 我会提供代码,但我认为这不是特别重要。 我想阻止UDF在某些时候计算(因为它是跨越几千个单元格,当我在工作表中处理其他事情时需要closures,以防止长时间的等待时间)。

目前,我用单元格B1(作为基本公式的输出)“Pause”来实现这一点,并且在我的UDF开始处的一个If语句检查这个,并在input暂停时退出函数。

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。 我想保留所有其他的工作簿function,所以手动计算不是一个选项(+当我保存/打开UDF计算不pipe,当我保存离开暂停是非常好的(如我在自己的尝试解决scheme),以便在打开/closures/保存工作表时不会发生这种计算)

你可以试试这个:

 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 

要注意的是,如果你的函数被称为不同的工作表,就必须加以改进