Problème vba excel

Résolu
LANGAZOU Messages postés 95 Date d'inscription   Statut Membre Dernière intervention   -  
LANGAZOU Messages postés 95 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

j'ai 2 feuilles excel, la première contienne des montants ,nombres de jours et des taux et sous la deuxième feuille une grille des Taux . je veux créer une macro dans la feuille une qui vérifie l'appartenance du montant et du nombre de jours dans la grille des taux (feuille 2) et me colorer les taux hors grille de taux.

voici le code que j'ai utilisé mais il me semble incorrect vu qu'il me colore du n'importe quoi. 

Sub GRILLE()

Dim TheRow As ListRow

For i = 2 To 1000

For Each TheRow In Feuil2.ListObjects("Tab_Taux").ListRows

    'On recherche la ligne qui correspond à critère Montant et Nbr de jour
   If Sheets("BC").Cells(i, 5) <> "" And Sheets("BC").Cells(i, 12) <> "" And Sheets("BC").Cells(i, 8) <> "" Then
    
    If Sheets("BC").Cells(i, 12) >= TheRow.Range(1, 1).Value And Sheets("BC").Cells(i, 12) <= TheRow.Range(1, 2).Value And Sheets("BC").Cells(i, 5) >= TheRow.Range(1, 3).Value And Sheets("BC").Cells(i, 5) <= TheRow.Range(1, 4).Value Then
        'On controle le taux
        If Sheets("BC").Cells(i, 8) > TheRow.Range(1, 5).Value Then
    
            Sheets("BC").Cells(i, 8).Font.Color = RGB(255, 0, 0)

            
            'On quitte la boucle
            Exit For
        End If
    End If

 End If
Next

Next

End Sub


veuillez trouver ci-dessous mon fichier:
https://www.cjoint.com/?3Bcvk3sSq8g

Merci pour votre aide
A voir également:

2 réponses

Réponse 1 / 2
eriiic Messages postés 24603 Date d'inscription   Statut Contributeur Dernière intervention   7 275
 
Bonjour,

à tester, je trouve beaucoup de rouges : 
Sub grille2()
    Dim taux, datas
    Dim lig1 As Long, lig2 As Long
    With Sheets("Feuil1")
        taux = .[A1:E1].Resize(.Cells(Rows.Count, 1).End(xlUp).Row).Value
    End With
    Application.ScreenUpdating = False
    With Sheets("BC")
        datas = .[E:L].Resize(.Cells(Rows.Count, 1).End(xlUp).Row)
        For lig1 = 2 To UBound(datas)
            .Cells(lig1, "H").Interior.ColorIndex = xlNone
            For lig2 = 2 To UBound(taux)
                If datas(lig1, 1) >= taux(lig2, 3) And datas(lig1, 1) <= taux(lig2, 4) Then
                    If datas(lig1, 8) >= taux(lig2, 1) And datas(lig1, 8) <= taux(lig2, 2) Then
                        If datas(lig1, 4) <> taux(lig2, 5) Then
                            .Cells(lig1, "H").Interior.ColorIndex = 3
                            Exit For
                        End If
                    End If
                End If
            Next lig2
        Next lig1
    End With
End Sub

eric

En essayant continuellement, on finit par réussir.
Donc plus ça rate, plus on a de chances que ça marche.(les Shadoks)
En plus du merci (si si, ça se fait !!!), penser à mettre en résolu. Merci
0
Réponse 2 / 2
LANGAZOU Messages postés 95 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour Mr Eric,

je vous remercie énormément pour votre réponse.

Après verification du résultat, votre code colore les taux inférieurs ainsi que supérieurs à la grille ! Avant de colorer les taux il faut que je verifie l'appartenance du montant et du nombre de jours à la ligne adéquate de la grille, après il y aura coloration des Taux qui sont lui sont supérieurs.
je suis débutant en VBA alors je suis bloqué :(

Merci.
0
eriiic Messages postés 24603 Date d'inscription   Statut Contributeur Dernière intervention   7 275
 
Bonjour,

Tu avais dit : colorer les taux hors grille de taux...
remplace : 
If datas(lig1, 4) <> taux(lig2, 5) Then

par : 
If datas(lig1, 4) > taux(lig2, 5) Then

eric
0
LANGAZOU Messages postés 95 Date d'inscription   Statut Membre Dernière intervention  
 
re bonjour,

Je vous remercie énormément Mr Eric.
juste un petit souci que je le trouve pas de solution:
- sur la première ligne, il me colore le taux 1.60 pourtant il n'a pas dépassé la grille. lorsque je retape le taux 1.60 avec le clavier et j'active mon macro la coloration disparaisse.j'ai verifié le format des cellules mais toujours pas de solution ( même problème pour la ligne 17) :/

ci-joint mon fichier rectifié:https://www.cjoint.com/?3BdmYHEygW3

Merci d'avance
0
eriiic Messages postés 24603 Date d'inscription   Statut Contributeur Dernière intervention   7 275
 
en M4 saisis : =H2-1.6-0
(le -0 est important même si apparemment il ne sert à rien)
Tu trouves = 4.44089E-16, ça suffit pour que vba dise que c'est supérieur.
C'est dû aux erreurs de conversion décimal binaire
Remplace par : 
If Round(datas(lig1, 4), 10) > taux(lig2, 5) Then

eric
0
LANGAZOU Messages postés 95 Date d'inscription   Statut Membre Dernière intervention  
 
Merci Merciii beaucoup :)) j'ai ajouté cette fonction Round sur mon code initiale aussi et ca marche très bien :) 

Sub GRILLE()

Dim TheRow As ListRow

For i = 2 To 1000

For Each TheRow In Feuil2.ListObjects("Tab_Taux").ListRows

    'On recherche la ligne qui correspond à critère Montant et Nbr de jour
   If Sheets("BC").Cells(i, 5) <> "" And Sheets("BC").Cells(i, 12) <> "" And Sheets("BC").Cells(i, 8) <> "" Then
    
    If Sheets("BC").Cells(i, 12) >= TheRow.Range(1, 1).Value And Sheets("BC").Cells(i, 12) <= TheRow.Range(1, 2).Value And Sheets("BC").Cells(i, 5) >= TheRow.Range(1, 3).Value And Sheets("BC").Cells(i, 5) <= TheRow.Range(1, 4).Value Then
        'On controle le taux
        If Round(Sheets("BC").Cells(i, 8), 10) > TheRow.Range(1, 5) Then
        
            Sheets("BC").Cells(i, 8).Font.Color = RGB(255, 0, 0)
        Else
            Sheets("BC").Cells(i, 8).Font.Color = RGB(0, 0, 0)
            
            'On quitte la boucle
            Exit For
        End If
    End If

 End If
Next

Next

End Sub


je vous remercie encore une fois chèr Eric et à très bientôt.
0