做while循环不适用于大数据文件

我在excel上有大数据文件，文件有6930行和8列，8列有百分数（0％，4％，16％，18％，19％等）。
我试图做一个macros来绘制所有的行，其中百分比大于18％的行，它不起作用。

该文件从第3行开始，因此第1行和第2行是空的

macros：

Sub Test_4 Dim i As Long Dim countErr As Long countErr = 0 i = 2 Do While Cells(i, 1) = "" If Cells(i, 8).Value > 0.18 And IsNumeric(Cells(i, 8)) Then Range(Cells(i, 1), Cells(i, 8)).Interior.ColorIndex = 3 countErr = countErr + 1 End If i = i + 1 Loop If countErr > 0 Then Sheets("test").Select Range("E8").Select Selection.Interior.ColorIndex = 3 Range("D8").Select Selection.FormulaR1C1 = countErr Else Sheets("test").Select Range("E8").Select Selection.Interior.ColorIndex = 4 Sheets("test").Range("d8") = "0" End If End Sub 

Answer 1

Do While循环可能是一个坏主意，如果列H有一个空白值的部分方式，而不是你可以这样做（这将添加条件格式到每一行）：

给出这个input：

 Sub testit() Dim LastRow As Long, CurRow As Long, countErr As Long LastRow = Range("H" & Rows.Count).End(xlUp).Row Cells.FormatConditions.Delete With Range("A3:H" & LastRow) .FormatConditions.Add Type:=xlExpression, Formula1:="=$H3>0.18" .FormatConditions(.FormatConditions.Count).SetFirstPriority .FormatConditions(1).Interior.ColorIndex = 3 .FormatConditions(1).StopIfTrue = False End With countErr = 0 Dim cel As Range For Each cel In Sheets("NAME OF SHEET").Range("H3:H" & LastRow) If cel.Value > 0.18 Then countErr = countErr + 1 End If Next cel MsgBox "There are " & countErr & " rows greater than 18%" End Sub 

运行代码给出：

错误testing：

 Sub ErrorTesting() Dim cel As Range, countErr As Long countErr = 0 LastRow = Range("H" & Rows.Count).End(xlUp).Row For Each cel In Range("H3:H" & LastRow) On Error GoTo ErrHandle If Not IsNumeric(cel.Value) Then MsgBox cel.Address & " is the address of the non-numeric Cell" End If If cel.Value > 0.18 And IsNumeric(cel.Value) Then countErr = countErr + 1 End If Next cel ErrHandle: If Not cel Is Nothing Then MsgBox cel.Address & " is the address and " & cel.Value & " is the value of the Error Cell" End If MsgBox countErr End Sub 

Answer 2

试试这个（更新错误计数） ：

 Sub test() Count = 0 i = 2 While Not IsEmpty(Cells(i, 8)) If Cells(i, 8).Value > 0.18 Then Range(Cells(i, 1), Cells(i, 8)).Interior.ColorIndex = 3 Count = Count + 1 End If i = i + 1 Wend //rows count bigger than 18% in worksheet "test" Worksheets("test").Cells(1, 1).Value = "Rows count bigger than 18%" Worksheets("test").Cells(1, 2).Value = Count End Sub