Question

我有一个迭代一些行的宏，以更新相关图表中数据点的颜色。行可以被用户隐藏，因此它会检查隐藏值，即

Do While wsGraph.Cells(RowCounter, 1) <> ""
    If wsGraph.Rows(RowCounter).Hidden = False Then
        'code here
    End If
    RowCounter = RowCounter + 1
Loop

此代码需要69秒才能运行。如果我对隐藏的行进行测试，则需要1秒才能运行。

有没有更好的方法来进行此测试，否则我将不得不告诉用户他们不能使用隐藏功能（或处理69秒的延迟）。

由于

根据要求，这是完整的代码。

图表是条形图，我根据某些范围内的值对点进行着色，例如：超过75％=绿色，超过50％=黄色，超过25％=橙色，否则为红色。表单上有一个按钮可以重新着色图表，执行此代码。

如果有人过滤了数据表，发生的事情就是这样：前20行超过75％，最初是绿色的。过滤表后，只说前5个超过75％。该图表仍显示前20个为绿色。因此，带宏的按钮会重新调整条形图。

' --- set the colour of the items
Dim iPoint As Long
Dim RowCounter As Integer, iPointCounter As Integer
Dim wsGraph As Excel.Worksheet
Set wsGraph = ThisWorkbook.Worksheets(cGraph5)
wsGraph.ChartObjects("Chart 1").Activate
' for each point in the series...
For iPoint = 1 To UBound(wsGraph.ChartObjects("Chart 1").Chart.SeriesCollection(1).Values)
    RowCounter = 26
    iPointCounter = 0
    ' loop through the rows in the table
    Do While wsGraph.Cells(RowCounter, 1) <> ""
        ' if it's a visible row, add it to the counter, if it's the same counter as in the series, exit do
        If wsGraph.Rows(RowCounter).Hidden = False Then
            iPointCounter = iPointCounter + 1
            If iPointCounter = iPoint Then Exit Do
        End If
        RowCounter = RowCounter + 1
    Loop
    ' colour the point from the matched row in the data table
    Dim ColorIndex As Integer
    If wsGraph.Cells(RowCounter, 5) >= 0.75 Then
        ColorIndex = ScoreGreen
    ElseIf wsGraph.Cells(RowCounter, 5) >= 0.5 Then
        ColorIndex = ScoreYellow
    ElseIf wsGraph.Cells(RowCounter, 5) >= 0.25 Then
        ColorIndex = ScoreOrange
    ElseIf wsGraph.Cells(RowCounter, 5) >= 0 Then
        ColorIndex = ScoreRed
    Else
        ColorIndex = 1
    End If
    ActiveChart.SeriesCollection(1).Points(iPoint).Interior.ColorIndex = ColorIndex
Next

Answer 1

尝试Special Cells

Sub LoopOverVisibleCells()
    Dim r As Range
    Dim a As Range
    dim cl As Range

    Set r = ActiveSheet.UsedRange.Columns(1).SpecialCells(xlCellTypeVisible)

    For Each a In r.Areas
        For Each cl In a
            ' code here
        Next
    Next

End Sub

Answer 2

这就是我所做的，使用克里斯的建议。它没有回答为什么隐藏的检查是如此缓慢，但它是一种更有效的方法来进行重新着色：

Dim myrange As range
Set myrange = wsGraph.range("E26:E304").SpecialCells(xlCellTypeVisible)
Dim i As Integer
For i = 1 To myrange.Rows.Count
    If myrange.Cells(i, 1) >= 0.75 Then
        ColorIndex = ScoreGreen
    ElseIf myrange.Cells(i, 1) >= 0.5 Then
        ColorIndex = ScoreYellow
    ElseIf myrange.Cells(i, 1) >= 0.25 Then
        ColorIndex = ScoreOrange
    ElseIf myrange.Cells(i, 1) >= 0 Then
        ColorIndex = ScoreRed
    Else
        ColorIndex = 1
    End If
    ActiveChart.SeriesCollection(1).Points(i).Interior.ColorIndex = ColorIndex
Next i

隐藏行的Excel VBA优化

2 个答案: