Question

您好我已经尝试了3种不同类型的色彩功能UDF，可以在线使用我的Excel 2013.但是每次刷新等都会一直崩溃...有一个修复程序可以阻止它（只有在完成时才能刷新它）手动地）

这是代码：

    Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As Boolean)
    Dim rCell As Range
    Dim lCol As Long
    Dim vResult

    lCol = rColor.Interior.ColorIndex
    If SUM = True Then
        For Each rCell In rRange
            If rCell.Interior.ColorIndex = lCol Then
                vResult = WorksheetFunction.SUM(rCell,vResult)
            End If
        Next rCell
    Else
        For Each rCell In rRange
            If rCell.Interior.ColorIndex = lCol Then
                vResult = 1 + vResult
            End If
        Next rCell
    End If
   ColorFunction = vResult
End Function

请帮助，因为这真的很烦人，我的整台计算机都崩溃了......

这可以放入我可以手动运行的宏中吗？会解决它吗？

额外的信息 - 运行Windows 8.1 ... Office 2013 ...我已经尝试过在三台不同的计算机上运行相同，同样也发生在Windows 7上的2010版本的办公室。只是崩溃excel尝试更新（可能记录太多但它们包含大约100行，这应该没问题？）

尝试以下也崩溃excel。只是说计算（3 PRCOESSOR（S））; 0％

    Function CountCellsByColor(rData As Range, cellRefColor As Range) As Long
    Dim indRefColor As Long
    Dim cellCurrent As Range
    Dim cntRes As Long

    Application.Volatile
    cntRes = 0
    indRefColor = cellRefColor.Cells(1, 1).Interior.Color
    For Each cellCurrent In rData
        If indRefColor = cellCurrent.Interior.Color Then
            cntRes = cntRes + 1
        End If
    Next cellCurrent

    CountCellsByColor = cntRes
End Function

它最终确实有效，但每个至少需要3分钟才需要相当长的时间...所以当它尝试用颜色函数更新40个字段时整个事情会崩溃

查看任务管理器并关注等待链，如果出现此问题，请访问splwow64.exe任何想法？

Answer 1

我会说你很有可能会触发另一个事件并进入无休止或非常广泛的循环。

通过禁用应用程序事件来测试它，看看你的函数是否运行得更快。我已经整理了一些代码并给出了一个如何禁用测试事件的示例。当然，请记住在完成后启用事件。

Public Function ColorFunction(rColor As Range, rRange As Range, Optional isAggregating As Boolean) As Variant
    Dim rCell As Range
    Dim iRefColourIndex As Integer
    Dim result As Variant

    'Try toggling this line false and true.
    'If there's a big speed difference then you must have a _Change event causing you trouble.
    Application.EnableEvents = False

    iRefColourIndex = rColor.Interior.ColorIndex
    result = 0
    For Each rCell In rRange.Cells
        If rCell.Interior.ColorIndex = iRefColourIndex Then
            If isAggregating And IsNumeric(rCell.Value2) Then
                result = result + rCell.Value2
            Else
                result = result + 1
            End If
        End If
    Next

    ColorFunction = result

End Function

ColorFunction UDF

1 个答案: