1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
|
Sub Blabla()
Dim dl, i, j, arrondi As Integer
Dim Pas As Double
dl = 50
Pas = 4
i = 3
j = i + 1
Do While i < dl
'---------Cette boucle permet de supprimer les valeurs contenues dans le Pas défini
Do While Cells(i, 1) - Cells(j, 1) < Pas
' Si des 2 valeurs supérieure au pas la première est plus proche
' de la valeur exacte de la première cellule (cells i,1) moins le pas
'alors exclure cette valeur de la suppression sinon la supprimer et garder la deuxième
If (Cells(j + 1, 1) + Cells(j, 1)) / 2 <= Cells(i, 1) - Pas Then
'important de mettre le = sur cette condition pour ne pas supprimer la valeur arrondie
' quand Cells(j + 1, 1) + Cells(j, 1)) / 2 = (exactement) Cells(i, 1) - Pas
Range(Cells(i + 1, 1), Cells(j - 1, 2)).Font.Color = RGB(192, 32, 255) 'coloration des C supprimées
arrondi = 1 ' marqueur pour déterminer où arrondir
ElseIf (Cells(j + 1, 1) + Cells(j, 1)) / 2 > Cells(i, 1) - Pas Then
Range(Cells(i + 1, 1), Cells(j, 2)).Font.Color = RGB(192, 32, 255) 'coloration des cellules supprimées
arrondi = 0 ' marqueur pour déterminer où arrondir
End If
j = j + 1
Loop
'------------------------------------
'---------------selon le marqueur on arrondi la valeur immédiatement inférieure ou supérieure au Pas
'de même on fixe i pour que la boucle while reprenne sa course au "bon endroit"
If arrondi = 1 Then
Cells(j - 1, 1) = Round(Cells(j - 1, 1), 1)
i = j - 1
ElseIf arrondi = 0 Then
Cells(j, 1) = Round(Cells(j, 1), 1)
i = j
End If
Loop
End Sub |
Partager