Question

我有一个带有主控制表的工作簿和40-50个不同的数据表，这些数据表从外部源复制/粘贴到文件中（每个工作表有30到500行，10到100列有数据）。

工作簿的目的是比较各种数据表列中的单元格，如果它们符合某个方差标准，则突出显示它们;然后计算每个数据表上突出显示的单元格并显示在主控制表上（使用UDF公式）。

在阅读了cpearson网站之后，我意识到如果你使用传统的条件格式化计算突出显示的单元格几乎是不可能的...但我只是在我已经在VBA中为40多张页面编写自定义CF代码之后才想到这一点（这个已经完成，以便在数据表被刷新＆＃34;使用复制/粘贴后，可以删除格式或使用宏按钮应用格式。

所以经过长时间的呐喊，我基本上使用循环来重建条件格式（再次在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

（填充数据列和散布在整个工作表中的隐藏行之间通常有空白列）

然后我创建了一个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}）的单元格不会自动更新;即使＆＃34; application.volatile＆＃34;对UDF有效，工作簿设置为自动计算。
速度

考虑到这两个条件（应用程序。易失性和自动计算），突出显示的单元格数量（UDF公式的输出）将仅在我单击其中一个UDF公式单元格并按F9（或我可以单击）时更新公式栏并按下回车键），但更大的问题是我的工作簿在我的页面上更新所有UDF公式时会超时4-5分钟（这是我基于更快的处理时间和更少的UDF公式的假设在页面上或UDF公式中使用的较小范围标准）。 *关闭application.volatile并自动计算产生类似的结果。

为了解决这个问题，我已经关闭了自动计算和application.volatile（这似乎没有任何影响）。

我知道这种方法不允许任何类型的输出UDF公式的自动更新（突出显示的单元格数），但现在每个UDF公式的手动重新计算（F9或公式＆＃34;输入＆＃34;）只需要5-10秒，具体取决于范围大小（它也只会更新您单击的单元格）。

当我尝试包含一个强制更新整个页面的单击按钮宏以消除更新每个UDF公式单元格的需要时（例如，＃34;参考＆＃34; ）.Calculate），我的计算时间然后在原始更新时间（3-4分钟）附近慢下来，让我质疑它毕竟是否真的快得多。

所有这一切都让我问...

有没有办法优化或加快我的自定义UDF的循环/处理时间？

自动更新将是锦上添花，但如果我必须强制进行手动重新计算，那么我希望它尽可能快。

如果我需要澄清任何内容，或者对我的工作簿/代码进行屏幕截图，请告诉我（如果我的解释相当复杂，我会事先道歉;我一直在限时使用VBA，我当然还是新手）。

注意：我使用的是Excel 2007。

感谢您提前!!

Answer 1

您的代码很慢，因为您引用Excel来检查范围中的每个单元格。最有效的方法是将使用过的范围加载到VBA内存并使用这些数组 - 检查这组文章 - 它非常有用且编写得很好https://fastexcel.wordpress.com/making-your-vba-udfs-efficient/

另外，为了加快计算速度，您可以计算工作表的范围，无需重新计算所有工作表。

希望这有帮助

Answer 2

You can keep a count of the colored cells as you color them, then use that value, instead of counting the colored cells in a separate operation.

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

VBA - 优化UDF（单元格颜色计数器）

2 个答案: