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

これは、クリスの提案を使用して、私が行ったことです。非表示のチェックが非常に遅い理由はわかりませんが、再色を行うより効率的な方法です。

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 に答える