Discussion :

[mouss4rs]

Bonjour,

J'aimerai faire une macro qui vérifie toutes les lignes et toutes le colonnes d'un onglet de mon fichier:

si la cellule contient un nombre, vérifier si le nombre contient plus de 7 chiffre après la virgule: si oui, la surligner en rouge.

voilà j'espère avoir été clair

je débute en vba ...

[Invité]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Round(1.123456789, 7) <> 1.123456789 Then MsgBox 1.123456789 & " <> " & Round(1.123456789, 7)

[Daniel.C]

Bonjour,

Je ne sais pas ce que tu entends par "surligner en rouge". J'ai mis la police en rouge souligné :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub test1()
    Dim C As Range
    For Each C In ActiveSheet.UsedRange
        If IsNumeric(C.Value) And C.Value <> 0 Then
            If Len(C.Value - Int(C.Value)) > 9 Then
                C.Font.Underline = True
                C.Font.ColorIndex = 3
            End If
        End If
    Next
End Sub

[mouss4rs]

POUR DANIEL.C:

remplir la cellule en rouge, pas le texte ! et puis c'est pas vraiment ça.

il me surligne 2,676566 alors qu'il comporte 6 chiffre aprés la virgule ce qu'il ne doit pas faire.
pareil, pour 27,67638.

ya un souci !

[Daniel.C]

"Ya un souci", oui. Tu n'es pas exempt de chercher à modifiier une macro qui ne fonctionne pas à ton goût, sinon tu resteras éternellement débutant. Maintenant, parle le langage Excel si tu veux être compris. Il n'y as pas de surlignage de texte ici, contrairement à Word. Ce que tu nommes ainsi s'appelle coloriage du fond de la cellule. Quant aux nombres :

1. 2.676566 ne déclenche pas de coloriage
2. 27.67638 : pour calculer, je calcule 27.67638 - 27. On tombe sur un cas de calcul aussi incorrect que connu. Le résultat obtenu - par macro - est : 0.676380000000002. Pour pallier le problème :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub test1()
    Dim C As Range
    For Each C In ActiveSheet.UsedRange
        If IsNumeric(C.Value) And C.Value <> 0 Then
            If Len(Round(C.Value - Int(C.Value), 14)) > 9 Then
                C.Font.Underline = True
                C.Font.ColorIndex = 3
            End If
        End If
    Next
End Sub

[parmi]

En reprenant le code de Daniel, avec un petit changement...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub test1()
    Dim C As Range
    Dim Tablo() As String
 
    For Each C In ActiveSheet.UsedRange
        If IsNumeric(C.Value) And C.Value <> 0 Then
            Tablo = Split(ActiveCell.Value, ".")
            If Len(Tablo(1)) > 7 Then
                C.Interior.ColorIndex = 3
            End If
        End If
    Next
End Sub

PS: n'oublie pas que ce sont des bénévoles qui t'aident...

[mouss4rs]

Voici ce que je fais:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Dim C As Range
    For Each C In ActiveSheet.UsedRange
        If IsNumeric(C.Value) And C.Value <> 0 Then
            If Len(Round(C.Value - Int(C.Value), 14)) > 9 Then
                C.Interior.Color = RGB(255, 0, 0)
            End If
        End If
    Next

le souci est toujours le même:
la cellule 26,8743907 n'est pas colorier en rouge.

J'ai fait un msgbox mais j'ai du mal mit prendre:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Dim C As Range
    For Each C In ActiveSheet.UsedRange
        If IsNumeric(C.Value) And C.Value <> 0 Then
            If Len(Round(C.Value - Int(C.Value), 14)) > 9 Then
            MsgBox " valeur lue: " & Len(Round(C.Value - Int(C.Value), 14)
                C.Interior.Color = RGB(255, 0, 0)
            End If
        End If
    Next

l'editeur me surligne en rouge la ligne donc pas bon...

help !

[Marc-L]

Bonjour.

si la cellule contient un nombre, vérifier si le nombre contient plus de 7 chiffre après la virgule: si oui, la surligner en rouge.

la cellule 26,8743907 n'est pas colorier en rouge.

Normal car elle n'a pas plus de sept chiffres après la virgule !


Sinon voici une approche simple calculant donc le nombre de chiffres après le séparateur décimal et ce,
quel qu'il soit, le point chez nos amis de la Belle Province - tabernacle ! - comme la virgule en France :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Function NumericCells(Rg As Range) As Range
    Dim Rc As Range, Rf As Range
 
    On Error Resume Next
    Set Rc = Rg.SpecialCells(xlCellTypeConstants, xlNumbers)
    Set Rf = Rg.SpecialCells(xlCellTypeFormulas, xlNumbers)
 
    If Not Rc Is Nothing And Not Rf Is Nothing Then
        Set NumericCells = Union(Rc, Rf)
    ElseIf Not Rc Is Nothing Then
        Set NumericCells = Rc
    Else
        Set NumericCells = Rf
    End If
 
    Set Rc = Nothing
    Set Rf = Nothing
End Function
 
 
Sub Demo()
    Dim Cel As Range, Rg As Range
 
    Set Rg = NumericCells(ActiveSheet.UsedRange)
 
    If Not Rg Is Nothing Then
                               SD$ = Mid$(CStr(1.2), 2, 1)
        Application.ScreenUpdating = False
 
        For Each Cel In Rg
            P& = InStr(Cel.Value, SD)
            If P And Len(Cel.Value) - P > 7 Then Cel.Interior.Color = vbRed
        Next
                            Set Rg = Nothing
        Application.ScreenUpdating = True
    End If
End Sub

Afin d'accélérer la procédure Demo, seules les cellules numériques sont traitées.
S'il y a déjà des cellules en rouge alors qu'elles ne devraient pas l'être,
les remettre avec un fond normal avant de lancer cette procédure …


Parmi t'étais pas loin mais sans la présence d'un séparateur décimal Tablo(1) déclenche une erreur …

__________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …

[mouss4rs]

ok ca marche !!
thanks you tabernacle !!