Problème vba excel

Résolu
LANGAZOU Messages postés 100 Statut Membre -  
LANGAZOU Messages postés 100 Statut Membre -
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 Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
     
    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
  2. LANGAZOU Messages postés 100 Statut Membre
     
    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 Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
       
      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 Messages postés 100 Statut Membre
       
      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 Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
       
      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 Messages postés 100 Statut Membre
       
      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