【问题标题】:Excel VBA: If ... then exit UDF without changing cell valueExcel VBA:如果...然后退出UDF而不更改单元格值
【发布时间】:2017-04-17 05:20:08
【问题描述】:

我四处寻找答案,但只能找到与普通 Excel 函数相关的内容。情况:我有一个用 Excel 编写的用户定义函数 (UDF)。我将提供代码,尽管我认为它不是特别重要。我想阻止 UDF 在特定时间计算(因为它跨越几千个单元格,并且在我处理工作表中的其他内容时需要关闭以防止长时间等待)。

目前,我通过包含(作为基本公式的输出)“暂停”的单元格 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 时,无论如何都会计算,最好在保存时保留暂停(就像我自己尝试解决方案)以便在打开/关闭/保存工作表时不会进行此计算)

【问题讨论】:

  • 不是一个完美的解决方案,但在函数中的某处使用 DoEvents 将允许您在函数在后台计算时处理工作表...
  • 如果那些 "other things" 不影响您的函数参数,那么添加 Application.Volatile = False 只会在其任何参数因重新计算而发生变化时重新计算。
  • 在处理工作表时将计算设置为手动?
  • @user3598756 “其他事情”是对源数据表所做的更改。在我的 UDF 中有一个部分用于计算整个表中的元素。这将被更新(尽管对于包含 UDF 的所有单元格不一定更改),但 Application.Volatile 在结果不会发生变化时会阻止重新计算吗?我对此表示怀疑,因为跟踪我的任何一个 UDF 单元格的先例会突出显示整个数据集。
  • 正如我所写,重要的是“不影响您的函数参数”。如果是这种情况,该函数将不会重新计算。没有必要怀疑:试试吧!

标签: vba excel user-defined-functions udf


【解决方案1】:

你可以试试这个:

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

需要注意的是,如果您的函数从不同的工作表中调用,则必须对其进行增强

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2018-08-02
    • 2020-12-14
    • 1970-01-01
    • 2016-02-22
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多