ColorFunction UDF

Question

嗨，我尝试了3种不同类型的颜色函数UDF，它们可以在我的Excel 2013网上找到。但是每次我刷新时它都会崩溃.有一个修复程序来停止此操作(只有在手动完成时，excel才能刷新它)

这是代码：

    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.2013年办公室。我已经尝试过在三台不同的计算机上运行，同样的情况也发生在windows 7上的2010版office上。仅仅是崩溃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个带有颜色函数的字段时，整个事件就会崩溃。

在任务管理器中查看并遵循等待链，如果这是问题的话，就会出现plwow64.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