1

我有一个遍历某些行的宏,以更新相关图表中数据点的颜色。这些行可以被用户隐藏,所以它检查隐藏的值,即

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
4

2 回答 2

2

尝试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
于 2012-06-16T11:30:25.360 回答
0

这就是我所做的,使用 Chris 的建议。它没有回答为什么隐藏检查这么慢,但它是一种更有效的重新着色方法:

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
于 2012-06-16T19:42:50.023 回答