Colorisation de case sous certaines condition (Problème de synthaxe ?)

  • Initiateur de la discussion Initiateur de la discussion Vich
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Vich

XLDnaute Nouveau
Salut tout le monde,

Je bloque su un problème depuis hier donc je viens demander un avis extérieur.

J'aimerais colorier des cases suivant des correspondance avec une base de données access.

Code:
'Application des pinces et positionneurs à utiliser
    Call LienAccess
    Dim NbContacts, J As Integer
    NbContacts = Range("A1").End(xlDown).Row
    Sheets("Rangement").Select
    For i = 2 To (NbCells * 2 + NbLigneSautee) 'Nombre de cellules à colorier, ou pas suivant la ref contacts
        Sheets("ACCESS Contacts").Select
        For J = 2 To NbContacts 'Liste les différents Contacts
            If Sheets("Rangement").Range("J" & i) = Sheets("ACCESS Contacts").Range("B" & J) Then 'Si refcontact = le contacts dans la base de données
                Sheets("Rangement").Range("K" & i) = Sheets("ACCESS Contacts").Range("H" & J) ' On rajoute 2 cellules qui n'ont rien a voir avec mon problème =)
                Sheets("Rangement").Range("L" & i) = Sheets("ACCESS Contacts").Range("I" & J)
                If Sheets("ACCESS Contacts").Range("M" & J) = "Non" Then 'Si la colonne M de la case actuellement selectionnée  alors on la colorie en orange + on force l'écriture en noir.
                    If Sheets("Rangement").Range("I" & i) <> "" Then 'Si la case n'est pas vide
                        Sheets("Rangement").Range("K" & i).Interior.ColorIndex = 46
                        Sheets("Rangement").Range("L" & i).Interior.ColorIndex = 46
                        Sheets("Rangement").Range("K" & i).Font.ColorIndex = 1
                        Sheets("Rangement").Range("L" & i).Font.ColorIndex = 1
                    End If
                End If
            End If
            If Sheets("Rangement").Range("K" & i) = "" And Sheets("Rangement").Range("L" & i) = "" Then 'Etant donné qu'il y a des lignes vides car on saute des lignes dans une autre méthode, si la ligne est qautée ( et donc vide) on ne la colore pas
                If Sheets("Rangement").Range("I" & i) <> "" Then ' L'erreur est ici, si la cellule est vide on la colorie en rouge.
                    Sheets("Rangement").Range("K" & i).Interior.ColorIndex = 3
                    Sheets("Rangement").Range("L" & i).Interior.ColorIndex = 3
                    Sheets("Rangement").Range("K" & i).Font.ColorIndex = 1
                    Sheets("Rangement").Range("L" & i).Font.ColorIndex = 1
                End If
            End If
        Next J
    Next i
    Sheets("ACCESS Contacts").Delete

Bref voilà en gros ... pour plus de détail je vous link un exemple de ce que je voudrais :

Regarde la pièce jointe Forum 1.xlsx

Merci d'avance,

Vich.
 

Pièces jointes

Re : Colorisation de case sous certaines condition (Problème de synthaxe ?)

Problème réglé après un gros brainstorming algo de ma part x) (A mon niveau du moins 😛)

Code:
    Call LienAccess
    Sheets("Rangement").Select
    For i = 2 To (NbCells * 2 + NbLigneSautee)
        Sheets("ACCESS Contacts").Select
        For J = 2 To NbContacts
            If Sheets("ACCESS Contacts").Range("M" & J) = "Non" Then
                If Sheets("ACCESS Contacts").Range("B" & J) = Sheets("Rangement").Range("J" & i) Then
                    Sheets("Rangement").Range("K" & i).Interior.ColorIndex = 46
                    Sheets("Rangement").Range("L" & i).Interior.ColorIndex = 46
                    Sheets("Rangement").Range("K" & i).Font.ColorIndex = 1
                    Sheets("Rangement").Range("L" & i).Font.ColorIndex = 1
                End If
            End If
            If Sheets("ACCESS Contacts").Range("M" & J) <> "Non" And Sheets("ACCESS Contacts").Range("M" & J) <> "" Then
                If Sheets("ACCESS Contacts").Range("B" & J) = Sheets("Rangement").Range("J" & i) Then
                    Sheets("Rangement").Range("K" & i).Interior.ColorIndex = Sheets("Rangement").Range("E" & i).Interior.ColorIndex
                    Sheets("Rangement").Range("L" & i).Interior.ColorIndex = Sheets("Rangement").Range("E" & i).Interior.ColorIndex
                    Sheets("Rangement").Range("K" & i).Font.ColorIndex = Sheets("Rangement").Range("E" & i).Font.ColorIndex
                    Sheets("Rangement").Range("L" & i).Font.ColorIndex = Sheets("Rangement").Range("E" & i).Font.ColorIndex
                End If
            End If
            If Sheets("Rangement").Range("K" & i) = "" And Sheets("Rangement").Range("L" & i) = "" Then
                If Sheets("Rangement").Range("J" & i) <> "" Then
                    Sheets("Rangement").Range("K" & i).Interior.ColorIndex = 3
                    Sheets("Rangement").Range("L" & i).Interior.ColorIndex = 3
                End If
            End If
        Next J
    Next i
    Sheets("ACCESS Contacts").Delete
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
8
Affichages
233
Réponses
5
Affichages
241
Réponses
4
Affichages
461
Réponses
3
Affichages
665
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
650
Réponses
4
Affichages
505
Réponses
3
Affichages
673
Retour