Suppression de colonnes avec for each

8mise-en-forme.xlsx (12.19 Ko)

Bonjour,

Je debute le vba (et j'ai trouvé énormément de choses ici), et j'ai un petit soucis.

Je souhaite supprimer des colonnes entieres en fonction de la valeur de la 1ere celulle de la colonne. J'ai utilisé la fonction in_array que j'ai trouvé sur ce site (bien pratique d'ailleurs). L'idée est que pour toute la ligne 1 (tant qu'il y a une valeur) cela la compare avec mon array, eet si la valeur de la cellule est contenue dans l'array alors on fait rien et sinon cela supprime toute la colonne.

Voici mon code actuellement

Function in_array(tableau, recherche)

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 mise_en_forme()
Dim cellule As Range
Application.ScreenUpdating = False
mon_tableau = Array("N°", "Statut", "Résumé", "Commentaire", "Description")

Rows("1").Select
For Each cellule In Selection
valeur_a_rechercher = cellule
If Not IsEmpty(cellule) Then

If Not in_array(mon_tableau, valeur_a_rechercher) Then
cellule.Activate
cellule.EntireColumns.Delete
Else
End If
End If
Next cellule

End Sub

Merci d'avance de votre aide

Bonjour,

Le principe, lorsqu'on veut supprimer des lignes ou colonnes, est de partir de la fin vers le début (d'où le Step -1)

Essaie avec ce code :

Sub suppr_col()
Dim DerCol As Long, I As Long
Dim Mon_Tableau
Mon_Tableau = Array("N°", "Statut", "Résumé", "Commentaire", "Description")
DerCol = Cells(1, Columns.Count).End(xlToLeft).Column 'Calcul de la dernière colonne
For I = DerCol To 1 Step -1 'on part de la dernière vers la première
    If IsError(Application.Match(Cells(1, I), Mon_Tableau, 0)) Then 'fonction EQUIV d'Excel
        Columns(I).Delete 'si on n'a pas la valeur dans Mon_Tableau, on supprime
    End If
Next I
End Sub

Cela marche parfaitement , merci beaucoup =)

Bonjour,

ci-joint autre proposition

Sub mise_en_forme()
    Dim cellule As Range
    Dim colonnes_à_supprimer As Range

    Application.ScreenUpdating = False

    mon_tableau = Array("N°", "Statut", "Résumé", "Commentaire", "Description")

    For Each cellule In ActiveSheet.UsedRange.Rows(1).Cells

        If Not in_array(mon_tableau, cellule.Value) Then
            If colonnes_à_supprimer Is Nothing Then Set colonnes_à_supprimer = cellule.EntireColumn _
            Else Set colonnes_à_supprimer = Union(colonnes_à_supprimer, cellule.EntireColumn)
        End If

    Next cellule

    colonnes_à_supprimer.Delete

End Sub

Function in_array(tableau, recherche)
    Dim i As Integer

    For i = LBound(tableau) To UBound(tableau)
        If tableau(i) = recherche Then 'Si valeur trouvée
            in_array = True
            Exit For
        End If
    Next i

End Function

NB : merci d'utiliser la balise "</>" pour insérer du code

Par contre si je relance la macro cela me met "variable ou variable de bloc with non definie" pour

colonnes_à_supprimer.Delete

Je suppose que je dois initier cette valeur au debut de mon sub pour qu'elle soit nulle ou vide (je ne sais pas comment on dit en vba)

Par contre si je relance la macro cela me met "variable ou variable de bloc with non definie" pour
Il suffit de conditionner la suppression :

If Not colonnes_à_supprimer Is Nothing Then colonnes_à_supprimer.Delete
Rechercher des sujets similaires à "suppression colonnes each"