VBA - 优化 UDF(单元颜色计数器)

Posted

技术标签:

【中文标题】VBA - 优化 UDF(单元颜色计数器)【英文标题】:VBA - Optimize UDF (Cell Color Counter) 【发布时间】:2015-12-09 22:35:12 【问题描述】:

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

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

阅读 cpearson 网站后,我意识到如果您使用传统的条件格式,计算突出显示的单元格几乎是不可能的......但我只是在我已经在 VBA 中编写了 40 多张纸的自定义 CF 代码之后才知道这一点(这个这样做是为了在使用复制/粘贴“刷新”数据表后,可以使用宏按钮删除或应用格式)。

因此,经过长时间的哭泣,我基本上使用循环重新创建了条件格式(再次在 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) 的单元格不会自动更新;即使 UDF 的“application.volatile”处于活动状态并且工作簿设置为自动计算也是如此。

    速度。

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

为了解决这个问题,我关闭了自动计算和 application.volatile(这似乎没有任何效果)。

我知道这种方法不允许对输出 UDF 公式(突出显示的单元格计数)进行任何类型的自动更新,但每个 UDF 公式的手动重新计算(F9 或公式“输入”)现在只需要 5-10秒取决于范围大小(它也只会更新您单击的单元格)。

当我尝试包含一个单击按钮宏来强制更新整个页面以消除更新每个 UDF 公式单元格的需要时,我的主要问题发生了(例如 ThisWorkbook.Worksheets("Reference").Calculate),然后,我的计算时间会减慢到接近原始更新时间(3-4 分钟),这让我怀疑它是否真的快得多。

所有这些都让我问...

有什么方法可以优化或加快我的自定义 UDF 的循环/处理时间?

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


如果我需要澄清任何事情,或截取我的工作簿/代码的屏幕截图,请告诉我(如果我的解释相当复杂,我提前道歉;我使用 VBA 的时间有限,当然我还是个新手)。

注意:我使用的是 Excel 2007。

提前谢谢你!!

【问题讨论】:

【参考方案1】:

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

也为了更快的计算 - 您可以计算工作表的范围,无需重新计算所有工作表。

希望对你有帮助

【讨论】:

【参考方案2】:

您可以在为彩色单元格着色时保留计数,然后使用该值,而不是在单独的操作中计算彩色单元格。

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(单元颜色计数器)的主要内容,如果未能解决你的问题,请参考以下文章

VBA - 根据具有数据的相邻单元格的计数插入行

VBA脚本上的Excel VBA对象需要错误在计数器时重复行

如何在VBA中设置背景颜色,以便在公式中检测到它?

vba excel计数

计数和复制动态范围Vba

当输入为科学计数法时,VBA Round() 函数始终返回零