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