[XL-2007] Faire une macro de vérification de donnée

Faire une macro de vérification de donnée

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 ...8O

Bonjour,

Code:

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

Bonjour,

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

Code:

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

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 !

"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:

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

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

Code:

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... ;)

Voici ce que je fais:

Code:

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:

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...8O8O

help !

Bonjour.

Citation:

Envoyé par mouss4rs

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.

Citation:

Envoyé par mouss4rs

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

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

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:

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 :plusser: pour chaque message ayant aidé puis sur :resolu: pour clore cette discussion …

ok ca marche !!
thanks you tabernacle !!