针对隐藏行的Excel VBA优化

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

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

这段代码需要69秒才能运行。 如果我对隐藏行进行testing，则需要1秒的时间才能运行。

有没有更好的方法来做这个testing，否则我将不得不告诉用户他们不能使用隐藏function（或处理69秒的延迟）。

谢谢

---

这是完整的代码，按要求。

该graphics是一个条形图，我根据这些值在特定范围内着色，例如：超过75％=绿色，超过50％=黄色，超过25％=橙色，否则为红色。 在窗体上有一个button来重新着色图表，它执行这个代码。

如果有人过滤数据表，那么发生的情况是：前20行超过75％，最初是绿色的。 过滤表格后，只说前5个是超过75％。 该图仍然显示前20个为绿色。 所以这个button与macros重新着色吧。

 ' --- 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

这是我所做的，使用克里斯的build议。 它没有回答为什么隐藏的检查是如此缓慢，但这是一个更有效的方法来做recolouring：

 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