Оптимизация Excel VBA для скрытых строк

Question

У меня есть макрос, который выполняет итерацию через несколько строк, чтобы обновить окраску точек данных в соответствующей диаграмме. Строки могут быть скрыты пользователем, поэтому он проверяет скрытое значение, т.е.

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

Этот код занимает 69 секунд для запуска. Если я возьму тест на скрытый вывод строки, для запуска потребуется 1 секунда.

Есть ли лучший способ сделать это испытание, иначе мне придется сказать пользователям, что они не могут использовать функцию hide (или иметь дело с задержкой 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