[英]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.