XL 2019 VBA : supprimer colonnes / lignes si conditions + MFC

ruliann · 20 Avril 2021

hello

Je récupère un tableau brut d'un fournisseur, avec de nombreuses lignes (environ 500) et colonnes (parfois jusqu'à 200) et j'aimerais mettre en page ce tableau.

Sur le tableau ci-joint, je souhaiterais :

supprimer les colonnes que j'ai surlignées en jaune (la condition : que le contenu de la cellule de la 2ème ligne, depuis la colonne I jusqu'à la dernière colonne renseignée, soit égal à 0)
supprimer les lignes que j'ai surlignées en rouge (la condition : que toutes les cellules de la ligne, depuis la colonne I jusqu'à la dernière colonne renseignée, soient égales à 0)

Et une fois ce tri effectué, j'aimerais appliquer un code couleur, comme l'exemple réalisé manuellement sur la ligne 5. J'avais pensé utilisé une MFC, mais vu que les valeurs des "prix" situées sur les colonnes D à H varient pour chaque ligne, cela veut veut dire que je dois paramétrer des MFC pour chaque ligne??? (ce qui prendrait beaucoup de temps)

pour le code couleur, n'y a-t-il pas une autre manière de faire qu'en paramétrant des règles de MFC pour chaque ligne?

merci pour votre aide, pour le moment je ne suis pas allé bien loin. Ce code destiné à supprimer les colonnes fonctionne, mais je dois relancer la macro à chaque fois, pour chaque colonne...

VB:

Sub Efface_colonne()

     For Each C In Range("I2:AM2")
        If C = "0" Then C.EntireColumn.Delete
    Next

End Sub

Lolote83 · 21 Avril 2021

Re salut.
Pense a marqué comme résolu le post du coup.
@+ Lolote83

Lolote83 · 21 Avril 2021

Re bonjour.
Content que cela corresponde à ta demande.
Voici donc le code commenté pour le deuxième fichier.
Recopie ce code dans ton 2ème fichier et exécute le, cela devrait fonctionner.

VB:

Sub Couleur()
    Application.ScreenUpdating = False
    xDerLig = Range("A65000").End(xlUp).Row                     'On détermine la dernière ligne saisie Colonne A (ICI = 9)
    Range("I5:Z" & xDerLig).Interior.Color = xlNone             'On met aucun remlissage sur plage I5:Z (dernière ligne)
    For Each xCell In Range("I5:Z" & xDerLig)                   'On boucle (Cellule) sur toutes les cellules de la plage I5:Z (dernière ligne)
        xLig = xCell.Row                                        'On récupère dans la variable xLig le numéro de ligne de la cellule lue
        If IsNumeric(xCell) = False Then GoTo SiNonNum          'Si cellule non numérique on va à SiNonNum (plus bas) pour passer à la cellule suivante
        For Each xCoul In Range("D" & xLig & ":H" & xLig)       'On boucle (Couleur) sur toutes les cellules de la plage D à H (en fonction du n° de ligne)
            If IsError(xCoul.Value) Then GoTo SiErreur          'A cause des #N/A, on va à SiErreur (plus bas) pour passer à la cellule suivante lue
            xCol = xCoul.Column                                 'On récupère dans la variable xCol le numéro de colonne de la cellule lue (D à H)
            xCoulSeuil = Cells(4, xCol).Interior.Color          'On récupère dans la variable xCoulSeuil la couleur de fond de la cellule (ligne4)
            xR = Int(xCoulSeuil Mod 256)                        'On récupère dans la variable xR (ROUGE)
            xV = Int((xCoulSeuil Mod 65536) / 256)              'On récupère dans la variable xV (VERT)
            xB = Int(xCoulSeuil / 65536)                        'On récupère dans la variable xB (BLEU)
            If xCell <= xCoul Then                              'On teste si la cellule (I à Z) <= cellule (D à H)
                xCell.Interior.Color = RGB(xR, xV, xB)          'Si c'est la cas, on colorie la cellule (I à Z) avec les couleurs RVB.
                Exit For                                        'On sort de la boucle
            End If                                              'Fin du Si
SiErreur:                                                       'Etiquette SiErreur
        Next xCoul                                              'Fin boucle Couleur
        xCell.Interior.Color = RGB(xR, xV, xB)                  'On colorie la cellule (I à Z) avec les couleurs RVB
SiNonNum:                                                       'Etiquette SiNonNum
    Next xCell                                                  'Fin boucle Cellule
    Application.ScreenUpdating = True
End Sub

Bon courage.
@+ Lolote83

ruliann · 21 Avril 2021

top merci bcp

Lolote83 · 21 Avril 2021

Re salut.
Pense a marqué comme résolu le post du coup.
@+ Lolote83

XL 2019 VBA : supprimer colonnes / lignes si conditions + MFC

ruliann

XLDnaute Occasionnel

Pièces jointes

Lolote83

Lolote83

XLDnaute Barbatruc

ruliann

XLDnaute Occasionnel

Lolote83

XLDnaute Barbatruc

Discussions similaires