2008/07/04

VBA 正確率

仮定:Eの赤文字 エラーを表す

Sub test()
Dim c As Range
Dim myRedCnt As Long
Dim myTotalCnt As Long

Application.ScreenUpdating = False
For Each c In ActiveSheet.Range("E1:E1000")
    With c.Font
        If .Color = vbRed Then myRedCnt = myRedCnt + 1
    End With
    If c.Value > 0 Then myTotalCnt = myTotalCnt + 1
Next

MsgBox "red word" & vbTab & vbTab & myRedCnt
MsgBox "black word" & vbTab & vbTab & myTotalCnt
MsgBox "正確率" & vbTab & vbTab & Round((myTotalCnt - myRedCnt) / myTotalCnt, 4)
Application.ScreenUpdating = True
End Sub

No comments: