calcul de seuils et de pourcentages un peu complexe

Sub GestionDesEcarts()
Dim i&
Dim n&
Dim Sh1 As Worksheet
Set Sh1 = Sheets("écarts")
Dim V1&
Dim V2&
Dim V3&
Dim V4&
Dim V5&
Dim V6&
Dim VHorsNorme&
Const S1 = 0.1
Const S2 = 0.1
Const S3 = 0.3
Const S4 = 0.2
Const S5 = 0.2
Const S6 = 0.2
Dim B0 As Byte
Dim B1 As Byte
Dim B2 As Byte
Dim B3 As Byte
Dim B4 As Byte
Dim B5 As Byte
Dim B6 As Byte

 B0 = 0
 B1 = 1
 B2 = 2
 B3 = 3
 B4 = 4
 B5 = 5
 B6 = 6
Dim R As Byte

n = Sh1.Cells(65536, 1).End(3).Row

For i = 2 To n
Select Case Sh1.Cells(i, 1).Value
    Case Is > B6: VHorsNorme = VHorsNorme + 1
    Case Is > B5: V6 = V6 + 1
    Case Is > B4: V5 = V5 + 1
    Case Is > B3: V4 = V4 + 1
    Case Is > B2: V3 = V3 + 1
    Case Is > B1: V2 = V2 + 1
    Case Is >= B0: V1 = V1 + 1
    Case Else: VHorsNorme = VHorsNorme + 1
End Select
Next i
For i = 1 To 6
    Select Case (V & i / n)
        Case Is > S & i: R = R + 0
        Case Else: R = R + 1
    End Select
Next i
If VHorsNorme > 0 Then
     MsgBox "Non Conforme. Ecarts Hors normes", vbCritical, "Vérification des écarts"
Else
    Select Case R
        Case 6
        MsgBox "Conforme", vbInformation, "Vérification des écarts"
        Case Else
        MsgBox "Non Conforme, norme dépassée", vbCritical, "Vérification des écarts"
    End Select
End If
Set Sh1 = Nothing
End Sub