Colorier cellules si plusieurs conditions

Question

J'ai besoin de votre aide pour réaliser une macro qui colorie automatiquement: 1- les cellules de la colonne B contenant "affaire 2 de..." ou "...affaire 5 sur..." ou "une affaire 11 de..." 2- les cellules de la colonne D contenant "activité8 sur..." ou "une activite13*" 3- si les cellules de la colonne F contiennent "...commandez...* et que celles de la colonne A differentes de "*societea*" ou "*societeb*" (sur une ligne donnée) 4- si les cellules de la colonne G contiennent "*Resultat A* ou "resultat B*" et que celles de la colonne C differentes de "*clienta*" ou "*clientb*" (sur la même ligne). J'ai éssayé un code, mais il ne marche pas bien (il ne colorie pas tout ce qui doit l'être, je ne sais pas pourquoi). J'aimerai dans un deuxième temps que la macro me demande si je veux exporter les lignes des cellules coloriées dans un tableau crée sur la feuille 2, si oui qu'elles y soient exportées (mais pas 2 fois car il y'a de nouvelles données dans mon tableau chaque mois. le but est d'automatiser le coloriage et l'exportation de nouvelles données. Merci d'avance pour votre aide. Je met en pièce jointe un fichier exemple...

MFerrand · Accepted Answer

Ajouter ceci : &#91;...&#93; End With If iTE = 0 Then MsgBox "Aucune ligne à esporter.", vbInformation, "Export" Exit Sub End If With Worksheets(2) &#91;...&#93; Je ne suis pas sûr de comprendre ce que tu veux faire : tu veux effacer l'export sur la feuille cible ? Cela n'enlèvera pas les colorations de la feuille source. Est-ce que c'est pour reprendre l'export à partir de la feuille source au début ? Pour reprendre tout de même à l'endroit où on en était ...

MFerrand · Answer

Méthode modulaire : Sub Export() Dim TEx(), n%, i%, k%, iTE%, iE%, nE%, tst As Boolean With Worksheets(2) nE = .Cells(.Rows.Count, 1).End(xlUp).Row iE = .Cells(nE, 8) + 1 .Cells(nE, 8).ClearContents End With With Worksheets(1) n = .Cells(.Rows.Count, 1).End(xlUp).Row For i = iE To n If Test1(i) Then .Cells(i, 2).Interior.Color = vbRed: tst = True End If If Test2(i) Then .Cells(i, 4).Interior.Color = vbRed: tst = True End If If Test3(i) Then .Cells(i, 6).Interior.Color = vbRed: tst = True End If If Test4(i) Then .Cells(i, 7).Interior.Color = vbRed: tst = True End If If tst Then iTE = iTE + 1: ReDim Preserve TEx(1 To 7, 1 To iTE) For k = 1 To 7 TEx(k, iTE) = .Cells(i, k) Next k End If Next i End With With Worksheets(2) .Cells(nE + 1, 1).Resize(UBound(TEx, 1), 7).Value = WorksheetFunction.Transpose(TEx) .Cells(nE + UBound(TEx, 1), 8) = n End With End Sub La procédure fait appel à 4 fonctions (une par test) et colore si le test est positif. Dès lors que l'un des tests est positif, elle exporte la ligne. La procédure ne prend en compte que les nouveaux éléments de la base : pour initialiser le processus, mettre 1 en H1 de Feuil2 (ce qui signifie que la base sera examinée à partir de la ligne 2) la macro effacera cette valeur, et après export, portera en H sur la dernière ligne exportée : 18 qui est la dernière ligne de la base traitée (ce qui signifie que la fois suivante elle examinera la base à partir de la ligne 19...) Cordialement...

MFerrand · Answer

Si tu as 2 lignes d'en-têtes la cellule A2 doit avoir un contenu, surtout sur la feuille cible (de façon que la recherche de la dernière ligne donne 2 quand aucun export n'a encore été fait, ou bien la rechercher sur une colonne dont la ligne 2 est occupée...) et la valeur a initialiser n'est plus 1 mais 2, et en W2 !

Tu redimensionnes le tableau sur 22 colonnes, ok ! mais la plage cible doit être redimensionnée également sur 22 et non 23 !

Cordialement.

MFerrand · Answer

Au temps pour moi cette fois J'ai croisé lignes et colonnes !!

With Worksheets(2)
        .Cells(nE + 1, 1).Resize(UBound(TEx, 2), 22).Value = WorksheetFunction.Transpose(TEx)
        .Cells(nE + UBound(TEx, 2), 23) = n

Le fait que dans ton modèle il y avait 7 lignes à exporter (autant que de colonnes) fait que je n'ai pas regardé plus avant, ce qui a masqué une autre bévue de ma part :

            If tst Then
                iTE = iTE + 1: ReDim Preserve TEx(1 To 22, 1 To iTE)
                For k = 1 To 22
                    TEx(k, iTE) = .Cells(i, k)
                Next k
                tst = False
            End If

Il faut réinitialiser la variable tst avant d'entamer le tour de boucle suivant. Si elle reste à True, cela exporte toutes les lignes !

Là ça devrait être bon.

MFerrand · Answer

Voilà le fichier modèle avec la macro rectifiée (selon les dernières indications données). Effectivement, avec les deux erreurs, elle fonctionnait (mal) la première fois et plantait à la seconde. Outre ces 2 rectifs, j'ai mis un test pour le cas où on lancerait la proc. alors qu'il n'y a pas de nouvelle ligne à traiter dans la base. Et renvoyé l'effacement de l'indication de la dernière ligne traitée antérieurement à la fin. &#91;...&#93; With Worksheets(2) nE = .Cells(.Rows.Count, 1).End(xlUp).Row iE = .Cells(nE, 8) + 1 End With With Worksheets(1) n = .Cells(.Rows.Count, 1).End(xlUp).Row &#91;...&#93; .Cells(nE + UBound(TEx, 2), 8) = n .Cells(nE, 8).ClearContents &#91;...&#93; Pour recommencer un test sur le modèle, il faut effacer les lignes exportées et rétablir la valeur effacée en H1. Ton adaptation consiste à mettre 6 en W6 pour démarrer (si les données commencent ligne 7 ; il m'avait semblé que c'était 7 en W7 et début ligne 8, précédemment...), et redimensionner pour les colonnes : 22 au lieu de 7 et 23 au lieu de 8... Le fichier que j'oubliais ...

MFerrand · Answer

Je vais regarder ton fichier...

Ci-dessous la macro commentée, ainsi que tu le souhaitais :

Sub Export()
    Dim TEx(), n%, i%, k%, iTE%, iE%, nE%, tst As Boolean
    'Récupération sur feuille cible de la dernière ligne utilisée (nE) et de
    ' la première ligne de la feuille source non encore traitée pour l'export (iE)
    With Worksheets(2)
        nE = .Cells(.Rows.Count, 1).End(xlUp).Row
        iE = .Cells(nE, 8) + 1
    End With
    With Worksheets(1)
    'Récupération de la dernière ligne utilisée de la feuille source (n)
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        'Si aucune ligne ajoutée à la base depuis le dernier export, n sera inférieur
        ' à iE : on interrompt la procédure dans ce cas
        If iE > n Then Exit Sub
        'Parcours en boucle des lignes à traiter de la feuille source, de iE à n
        For i = iE To n
            'On opère les tests successifs sur chaque ligne,par appel d'une fonction
            ' spécifique par test, renvoyant VRAI si le test est positif ou FAUX
            ' Si VRAI, on colore (la cellule qui doit l'être) et on affecte la valeur
            ' True à une variable booléenne (tst)
            If Test1(i) Then
                .Cells(i, 2).Interior.Color = vbRed: tst = True
            End If
            If Test2(i) Then
                .Cells(i, 4).Interior.Color = vbRed: tst = True
            End If
            If Test3(i) Then
                .Cells(i, 6).Interior.Color = vbRed: tst = True
            End If
            If Test4(i) Then
                .Cells(i, 7).Interior.Color = vbRed: tst = True
            End If
            'En fin de tests, si au moins l'un des tests a été positif, la ligne est à
            ' exporter (la valeur de la variable tst nous l'indique)
            If tst Then
                'Dans ce cas, on incrémente une variable (iTE) au moyen de laquelle on
                ' redimensionne un tableau Export [TEx(colonnes, lignes)]
                ' Les colonnes sont fixes (indice minimal à 1 pour conserver la correspondance
                ' indice-numéro de colonne
                ' Les lignes vont varier en utilisant la variable iTE, incrémentée chaque fois
                ' qu'une ligne doit être ajoutée
                ' Seule la dernière dimension d'un tableau dynamique peut être modifiée en
                ' cours d'exécution en préservant les valeurs déjà affectées au tableau,
                ' ce pourquoi on a : TEx(col.,lignes) au lieu de TEx(lignes, col.)
                iTE = iTE + 1: ReDim Preserve TEx(1 To 7, 1 To iTE)
                'Une fois le tableau redimensionné, on sert la ligne en affectant les
                ' valeurs de chaque colonne au moyen d'une boucle
                For k = 1 To 7
                    TEx(k, iTE) = .Cells(i, k)
                Next k
                'On réinitialise tst à False pour le tour suivant...
                tst = False
            End If
        Next i
    End With
    'Une fois les lignes à exporter recueillies sur la feuille source, on va affecter ce
    ' résultat à la feuille cible
    With Worksheets(2)
        'On dimensionne la plage cible, qui commence donc à la ligne qui suit nE (dernière
        ' ligne utilisée de la feuille cible) et en col. A, et qui comprend autant de lignes
        ' que l'indice max. de la 2e dimension du tableau TEx (dont l'indice minimal est 1)
        ' [NB- on aurait pu remplacer UBound(TEx, 2) par iTE qui a servi à incrémenter les
        ' lignes du tableau et a la même valeur...]
        ' Le nombre de col. est fixe et identique à la feuille source...
        'On affecte tableau TEx en transposant ses dimensions pour les faire correspondre
        ' à la plage
        .Cells(nE + 1, 1).Resize(UBound(TEx, 2), 7).Value = WorksheetFunction.Transpose(TEx)
        'On conserve le numéro de la dernière ligne traitée sur la feuille source pour la
        ' prochaine fois (cette colonne peut être masquée dans la feuille cible...)
        .Cells(nE + UBound(TEx, 2), 8) = n
        'On efface le numéro de dernière ligne antérieur...
        .Cells(nE, 8).ClearContents
    End With
End Sub

MFerrand · Answer

A première vue, ce qui se passe, c'est qu'aucun test n'est positif sur ton fichier ! Donc aucune ligne à exporter ! Je vais regarder ce qui se passe au niveau des tests...

MFerrand · Answer

Je vois ce que c'est !

La fonction Split utilise comme séparateur par défaut l'espace (on ne le mentionne pas dans ce cas...). Mais évidemment, si tu y places des expressions incluant des espaces, elles vont se trouver fractionnées et peu de chances qu'un test soit positif (ou au moins positif de la façon voulue.

L'objectif dans la constitution d'un tel tableau était de réduire le nombre d'expression à tester, en choisissant des fragments sans espaces et en les encadrant de * (qui signifie que l'expression visée peut être précédée d'un nombre quelconque de caractères ou aucun et suivie d'un nombre quelconque de caractères ou aucun.

Il convient donc de reconstruire tous les tests.

Et ajouter un test dans la macro pour que l'absence de test positif (cas envisageable) ne déclenche pas d'erreur.

MFerrand · Answer

Si ton en-tête sur la feuille cible n'occupe plus que 3 lignes, c'est en W3 qu'il faut initialiser la valeur 6 (mais toujours 6 si l'entête de la feuille source comporte 6 lignes...)

Pour les tests, tu n'as pas non plus remarqué que les expressions étaient toutes en minuscules (et la valeur de la cellule à tester était convertie systématiquement en minuscules [fonction LCase]), or tes expressions comportant toutes des majuscules, cela explique qu'aucune ne soit passée, même par erreur !

MFerrand · Answer

Pour les tests :

les expressions de type :

vt = LCase(Replace(Worksheets(1).Cells(n, 6), " ", ""))

convertissent la valeur de la cellule à tester en une expression minuscules en supprimant toutes les espaces.

Les modèles d'expressions à comparer doivent être construits en conséquence :

exemples : "*nonaffect*" couvrira toutes les variantes de non affecté

et si le affecté n'intervient qu'avec non, on peut même se contenter de : "*affect*"

ne pas mettre de s (marque pluriel) pour une expression pouvant intervenir au singulier ou pluriel

on peut dissocier des mots d'une même expression pour en faire des modèles distincts s'ils peuvent intervenir individuellement (en donnant lieu à export)

etc.

Si les modèles se réduisent à un seul, inutile d'en faire un tableau, on compare directement :

If vt Like "*affect*" Then

Cordialement.