VBA – 优化UDF（单元格颜色计数器）
我有一个主控制表和40-50个不同的数据表的工作簿，从外部来源（每个表格有30到500行和10到100列的数据）复制/粘贴到文件中。
该工作手册的目的是比较各种数据表栏中的单元格，如果符合某个方差标准，则将其突出显示; 然后每个数据表上的高亮显示的单元格被计数并显示在主控制表单上（使用UDF公式）。
在读完cpearson网站之后，我意识到，如果使用传统的条件格式，计算突出显示的单元格几乎是不可能的……但是我只有在我已经在VBA中将自定义的CF代码写入了40多张表格之后才明白这一点在数据表被使用复制/粘贴“刷新”之后，格式化可以被删除或者通过macrosbutton来应用）。
所以，经过一个很长的哭泣，我基本上重新创build条件格式（再次在VBA）使用循环来实现我的目标。
示例标准：比所比较的单元值小或大于25％。
示例数据表：
[col 1] *** [col 2] 2014 *****2015 1 *********1.1 3 **********3 532 *******555 323 *******46 <<<this would Highlight 42 *******-112 <<<<this would highlight (The highlighting would occur if cells in col 2 are either 25% greater or less than the cells in col 1 cell for the corresponding row.) asterisks are only used for the purpose of spacing the two columns in this example 示例代码：
Dim ref As WorksheetDim wkb As Workbook Set wkb = ThisWorkbook Set ref = ThisWorkbook.Sheets("Reference") pn1 = ref.Range("E17").Value With wkb.Sheets(pn1) .Select Set e1 = wkb.Sheets(pn1) For i = 7 To 53 j = 2 k = j + 8 If e1.Cells(i, j).Value > 0 And IsNumeric(e1.Cells(i, j).Value) = True _ Then If e1.Cells(i, j).Value > 1.25 * e1.Cells(i, k).Value _ Or e1.Cells(i, j).Value < 0.75 * e1.Cells(i, k).Value _ Then e1.Cells(i, j).Interior.Color = RGB(252, 213, 181) If e1.Cells(i, j).Value < 0 And IsNumeric(e1.Cells(i, j).Value) = True _ Then If e1.Cells(i, j).Value < 1.25 * e1.Cells(i, k).Value _ Or e1.Cells(i, j).Value > 0.75 * e1.Cells(i, k).Value _ Then e1.Cells(i, j).Interior.Color = RGB(252, 213, 181) Next i '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' For i = 7 To 53 j = 2 k = j + 9 If e1.Cells(i, j).Value > 0 And IsNumeric(e1.Cells(i, j).Value) = True _ Then If e1.Cells(i, j).Value > 1.25 * e1.Cells(i, k).Value _ Or e1.Cells(i, j).Value < 0.75 * e1.Cells(i, k).Value _ Then e1.Cells(i, j).Interior.Color = RGB(252, 213, 181) If e1.Cells(i, j).Value < 0 And IsNumeric(e1.Cells(i, j).Value) = True _ Then If e1.Cells(i, j).Value < 1.25 * e1.Cells(i, k).Value _ Or e1.Cells(i, j).Value > 0.75 * e1.Cells(i, k).Value _ Then e1.Cells(i, j).Interior.Color = RGB(252, 213, 181) Next i End With End Sub
（在填充的数据列和隐藏的行之间经常存在空白列，分散在整个表格中）
然后我创build了一个UDF来适应我的计数需求：
Function CountRed(MyRange As Range) As Integer 'Application.Volatile CountRed = 0 For Each cell In MyRange If Not cell.EntireRow.Hidden And cell.Interior.Color = RGB(252, 213, 181) CountRed = CountRed + 1 End If Next cell End Function
我有两个主要问题：
-
应用条件格式时，显示UDF公式（= CountRed [WkshtName] {Range：Range}）的单元格不会自动更新; 即使“UDF”的“application.volatile”处于活动状态，并且工作簿被设置为自动计算，情况也是如此。
-
速度。
考虑到这两个条件（application.volatile和自动计算），突出显示的单元格数（UDF公式的输出）将只会更新，如果我点击一个UDF公式单元格，然后按F9（或者我可以单击公式栏并按回车键），但更大的问题是，我的工作簿时间固定4-5分钟，而它更新我的网页上的所有UDF公式（这是我的假设基于更快的处理时间，在页面上用较less的UDF公式或UDF公式中使用的较小范围标准）。 *closuresapplication.volatile并留下自动计算得到类似的结果。
为了解决这个问题，我已经closures了自动计算和application.volatile（这看起来没有任何效果）。
我知道这种方法不允许任何types的输出UDF公式的自动更新（突出显示的单元格计数），但是每个UDF公式的手动重新计算（F9或公式“input”）现在只需要5-10秒，具体取决于范围的大小（它也只会更新你点击的单元格）。
当我尝试并包含一个单击buttonmacros，强制更新整个页面以消除更新每个UDF公式单元格（例如ThisWorkbook.Worksheets（“Reference”）Calculate），我的计算时间然后在原始更新时间（3-4分钟）附近慢下来，让我质疑是否真的快得多。
所有这些让我问…
有没有什么办法来优化或加快我的自定义UDF的循环/处理时间？
自动更新将锦上添花，但如果我不得不强制手动重新计算，那么我会喜欢它尽可能快。
请让我知道，如果我需要澄清任何事情，或采取我的工作簿/代码的屏幕截图（如果我的解释是相当复杂的，我提前道歉，我已经在有限的时间使用VBA，当然还是新手）。
注意：我正在使用Excel 2007。
先谢谢你 ！！
您的代码很慢，因为您引用Excel来检查范围中的每个单元格。 最有效的方法是将使用的范围加载到VBA内存中，并使用这些数组 – 检查这组文章 – 这是非常有用和写得很好https://fastexcel.wordpress.com/making-your-vba-udfs-高效/
也为了更快的计算 – 您可以计算工作表的范围，不需要重新计算所有工作表。
希望这可以帮助
您可以在着色时保留彩色单元的计数，然后使用该值，而不是在单独的操作中计算彩色单元。
Sub DoColors() Dim ref As Worksheet, e1 As Worksheet Dim wkb As Workbook, pn1 Dim rw As Range, i As Long, j As Long, n As Long, v, v2, v3 Set wkb = ThisWorkbook Set ref = wkb.Sheets("Reference") pn1 = ref.Range("E17").Value Set e1 = wkb.Sheets(pn1) j = 2 n = 0 For i = 7 To 53 Set rw = e1.Rows(i) v = rw.Cells(j).Value If IsNumeric(v) And v > 0 Then v2 = rw.Cells(j + 8).Value v3 = rw.Cells(j + 9).Value If Abs(v - v2) / v2 > 0.25 Or Abs(v - v3) / v3 > 0.25 Then rw.Cells(j).Interior.Color = RGB(252, 213, 181) n = n + 1 End If End If Next i 'put n somewhere... End Sub