Problème vba excel

Résolu
LANGAZOU -  
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

2 réponses

  1.  eriiic Contributeur
    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
    1. LANGAZOU Auteur
      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
      1. eriiic Contributeur
        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
      2. LANGAZOU Auteur
        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
      3. eriiic Contributeur
        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
      4. LANGAZOU Auteur
        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