|
>入力する度にD列の値を全部調べ直すので非効率的ですよね。
これは、
> Set mR = Me.Range("D10", Me.Range("D10").End(xlDown))
D10から、その下のデータ入力したセルまでの範囲
という事ですが、それでも入力する度に処理されますので、
>データ入力が終了したらコードを実行する
方がいいですよね。
Sub 五位まで表示()
Dim mR As Range
Dim v
Dim i As Long
Dim x As Variant
Set mR = Range("D10", Range("D10").End(xlDown))
If Application.WorksheetFunction.CountA(mR) = 0 Then Exit Sub
v = mR.Value
mR.Font.ColorIndex = 0
For i = 1 To UBound(v, 1)
If Not IsEmpty(v(i, 1)) Then
Select Case Application.WorksheetFunction.Rank(v(i, 1), mR)
Case 1: x = 3
Case 2: x = 4
Case 3: x = 5
Case 4: x = 7
Case 5: x = 46
Case Else: x = 0
End Select
If x > 0 Then
mR(i, 1).Font.ColorIndex = x
End If
End If
Next
End Sub
|
|