Suppression de colonnes si

Bonjour à tous et toutes,

J'ai réaliser un fichier avec des macro me permettant de "colorier" des cellules en fonction du texte inclus à l'intérieur cependant je viens de me rendre compte que parfois des colonnes supplémentaires sont présentes dans mon fichier initial. Or à la base j'avais fais mes formules suivant les colonnes ce qui décale tout et rend inefficace ma macro.

Afin de rendre "uniforme" le fichier de départ je souhaite vérifier le contenu de la ligne 4 pour toutes les colonnes et supprimer les colonnes dont le texte est différent de "Livre""Auteur""Couverture""Année",...

La valeur a vérifier concernant ma colonne sur la ligne 4.

J'ai essayé pour commencer de passer par le code

For i = 1 To 50
    If Cells(4, i).Value <> "Livre" Then
    Columns(i).Delete
    End If
Next i

cela me supprime bien des colonnes mais pas toutes celles différentes de "Nom" et ralenti pas mal l'exécution de plus je coince sur la vérif que d'un critère alors que je souhaite en vérifier plusieurs ("Livre""Auteur""Couverture""Année",...)

Auriez-vous une idée s'il vous plait ?

D'avance merci pour vos retours.

Hello,

Pour tes conditions, tu peux utiliser "and"

Exemple :

 If Cells(4, i).Value <> "Livre" And Cells(4, i).Value <> "Auteur" And Cells(4, i).Value <> "Couverture" Then

Pour accélérer l'exécution de ta macro, tu peux désactiver les animations avec (à mettre en début de code) :

Application.ScreenUpdating = False

A+

Bonjour Cadi49, Skiinck, le forum,

je souhaite vérifier le contenu de la ligne 4 pour toutes les colonnes et supprimer les colonnes dont le texte est différent de "Livre""Auteur""Couverture""Année",...

Un essai....avec mise en pratique de la fonction du site: in_array

Function in_array(tableau, recherche)
    'https://www.excel-pratique.com/fr/astuces_vba/recherche-tableau-array
            in_array = False
      For i = LBound(tableau) To UBound(tableau)
        If tableau(i) = recherche Then 'Si valeur trouvée
            in_array = True
            Exit For
        End If
      Next
End Function

Sub test()   'macro pour supprimer les colonnes
 Dim dercol As Integer
     dercol = Cells(4, Cells.Columns.Count).End(xlToLeft).Column   'dernière colonne utilisée sur la ligne 4
    mon_tableau = Array("Livre", "Auteur", "Couverture", "Année")  'tes critères ("tableau" dans la fonction "in_array")
  For i = dercol To 1 Step -1                                      'boucle de la dernière colonne à la première
    valeur_a_rechercher = Cells(4, i)                              '("recherche" dans la fonction "in_array")
     If in_array(mon_tableau, valeur_a_rechercher) = False Then Columns(i).Delete Shift:=xlToLeft 'si la fonction renvoie FAUX, on supprime la colonne
  Next i
End Sub

Nota: lorsqu'on effectue une boucle pour supprimer des colonnes (où des lignes), il faut commencer par la fin.

Cordialement,

Super merci beaucoup ca fonctionne très bien.

Néanmoins désolé d'être embetant mais en réalisant cette opération cela provoque une erreur dans le remplissage de mes couleurs.

Après vérif cela s'avère normal étant donné que je travaillais directement sur "les colonnes" cf code (merci ddetp88)

Dim c As Variant, Coul As Variant, Espace As Byte, Tiret As Byte, Fond As Byte

Dim Couleur As String

On Error GoTo ErreurCouleur

With ActiveSheet

   For Each c In .Range("F5:I" & .Range("I" & Rows.Count).End(xlUp).Row)

      Espace = InStr(c, ":") + 1

      Tiret = InStr(c, "-") - 1

      Couleur = Mid(c, Espace, Tiret - Espace)

      With Sheets("BaseCouleurs")

         For Each Coul In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)

            If Coul = Couleur Then

               c.Interior.ColorIndex = .Range("B" & Coul.Row).Interior.ColorIndex

               c.Font.ColorIndex = .Range("B" & Coul.Row).Font.ColorIndex

            End If

         Next

      End With

   Next

End With

Exit Sub

'Gestion des erreurs

ErreurCouleur:

MsgBox "L'écriture des couleurs n'est pas respectée. Revoir la cellule " & c.Address

ActiveSheet.Range(c.Address).Select

Or après vérification j'ai 4 cas de figures:

- les couleurs sont en colonnes I et J

- les couleurs sont en colonnes G,H,I et J

- les couleurs sont en colonnes F,H,I et K

- les couleurs sont en colonnes F et H

Savez-vous comment je pourrais corriger l'erreur ? Je pense qu'il me faut faire une recherche sur le nom de la colonne pour savoir sur lesquelles travailler mais la j'avoue je suis largué.

Merci beaucoup encore une fois.

Bonjour à toutes et tous,

petite précision ne pouvant pas savoir quelles sont les colonnes en question le seul élément "identifiable" serait le fait qu'en ligne 4 se trouve le "titre" des colonnes et que celles à colorer débutent toutes par "Couleur ..."

Cf exemple ci dessous

Merci pour vos retours

Bonjour Cadi49, le forum,

Un essai......

Cordialement,

Re,

Une variante avec définition des couleurs sur la Feuille "Couleurs"....(Tu peux en rajouter)

Cordialement,