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

Question

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

文件从第3行开始，因此第1行和第2行为空

宏：

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

如果列H的某个空白值部分向下，则Do While循环可能不是一个好主意，而是可以执行此操作（这将为每行添加条件格式）：

鉴于此输入：

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

运行代码给出：

错误测试：

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