Excel 色函数

您好，我已经尝试了3种不同类型的colorfunction自定义项，它们可在线用于我的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。。。我已经试过在三台不同的电脑上运行，同样的情况也发生在Windows7上的2010版office上。只是在试图更新excel时崩溃（可能记录太多，但它们包含大约100行，这应该可以吗？）

---

尝试了以下也会导致excel崩溃的操作。只说计算（3名副教授）；0%

---

它最终会起作用，但每一个都需要相当长的时间，至少3分钟。。。因此，当它试图用中的ColorFunction更新40个字段时，整个过程都崩溃了

---

---

在任务管理器中查看并遵循等待链，会出现splwow64.exe。如果这是问题所在，您有什么想法吗？

我想说，您很可能触发了另一个事件，并且正在进入一个无休止或非常广泛的循环

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

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

---

如果[F9]使该代码使您的计算机崩溃，请尝试在您的Office 2013安装上进行修复安装。Hello@Jeeped，我已经确定它不是Office。。。我在其他装有excel 2013的电脑上进行了测试，结果也崩溃了。只是说使用CPU 4进行处理（在我的例子中）。所以问题肯定出在代码中，或者excel不能有效地使用它？也许是函数对条件格式或事件宏（如工作表更改）的反应方式，但是代码（尽管有点草率）没有问题。@Jeeped字面上说我为什么来这里，在过去的两个星期里，我一直在看它，我想不出来！它让我发疯：（它肯定不是excel，也不是我使用的计算机……只要我拿出代码，它就可以工作。（有趣的是，它用于2007年）嗨，我刚刚试过这么做，结果完全一样！我想我已经找到了答案，因为我引用了另一张表，它崩溃了！我这么做，它引用了同一张表，它工作了。我发现这不是问题所在，@ambie问题是我选择了整个专栏啊，好的，我不明白为什么这个函数不能跨页工作。

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