[VBA] chercher la colonne selon son contenu

Anthonymctm

XLDnaute Occasionnel
Rebonjour le Forum,

J'ai fait une petite macro qui me permet de supprimer les lignes dont la cellule en B est égal à un texte.
VB:
  Dim p As Range, plage As Range
    
    Set plage = Range("B:B")
    With plage
        For Each cel In plage.Cells
            If cel = "AD-DEBUT" Or cel = "HNONP" Then If p Is Nothing Then Set p = cel Else Set p = Union(p, cel.MergeArea)
        Next
    End With
  p.EntireRow.Delete

Sauf que l'information qui est en B ne sera pas forcément en B.
J'ai besoin de remplacer B par une variable qui sera trouvée selon ce qui est indiqué dans la ligne A.

La macro doit s'appliquer sur les ligne dont le titre de la colonne est "Code OF".

exemple : si Code OF est en E1
alors ce sera comme si le code était Set plage = Range("E:E")

Je n'ai pas besoin de trouver cette variable à chaque exécution de la boucle, juste à chaque lancement de la macro.
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @Anthonymctm :)
QUOTE="Anthonymctm, post: 20333915, member: 216449"]
Merci de ton aide. Au début je pensais que ça ne fonctionnait pas mais je pense que c'est parcequ'à la fin tu as mis p.EntireColumn.Delete au lieux de entireRow. Je vais faire quelques tests sur le reste mais ça devrait marcher. [/QUOTE]
Bien vu ;). Quelle étourderie de ma part :mad:. J'ai remplacer les fichiers par leurs versions corrigées.
Merci à toi :).
Rem : J'ai inclus la suppression de la ligne d'en-tête.

Est-ce que tu peux m'expliquer pourquoi tu tries les données ?
Oui. Au départ, les lignes à supprimer sont dispersées tout au long du fichier. Si le fichier est très grand, s'il y a de très nombreuses lignes dispersées à supprimer, alors la suppression des lignes est interminable et peut même aboutir à une erreur.

Le fait de trier la colonne où se trouve les #N/A rassemble en un seul bloc toutes les lignes à supprimer. La suppression de ce bloc est très rapide et normalement cela n'aboutit jamais à une erreur.
 
Dernière édition:

Anthonymctm

XLDnaute Occasionnel
Alors de ce que j'ai vu tu as repris la V2 et pas le code que j'ai modifié.

Ce n'est pas grave, j'essaye de m'adapter ^^.
Par contre j'ai un probleme avec le tri, c'est que comme il tri aussi la ligne de titre je ne peux pas effectuer une autre suppression via une autre colonne.

En fait je veux supprimer les codes OF HNONP et AD-DEBUT sur touts les onglets (c'est pour ça que dans mon code je le faisais avant de le copier coller)
Si je le fais après, alors il faudrait filtré les lignes après la ligne 1. Comme ça on garde les titres en ligne 1, on fait les autres filtres puis on supprime la ligne 1


Edit : J'ai du confondre avec une autre version, parceque visiblement la ligne 1 n'est pas trié puisqu'on parvient à la supprimer, donc j'ai bien pu faire mon code. Un peu long tout de même ^^'

VB:
Option Explicit

Sub Clean()
   Dim numcol As Long, p As Range, plage As Range, Prem As Range, Der As Range
  
  
   Application.ScreenUpdating = False
   ' on copie les cellules de la fenêtre "Feuil1" ( la fenêtre où se trouve le bouton ? )
   Sheets("Feuil1").Cells.Copy Sheets("Temps salariés").Cells       ' sur la feuille "Temps salariés"
   Sheets("Feuil1").Cells.Copy Sheets("Temps machine").Cells        ' sur la feuille "Temps machine"
      
   '========================================================================================================
   '========================  Temps machine  ==========================================================
   '========================================================================================================
   Sheets("Temps machine").Activate      'on sélectionne la feuille "Temps machine"
   ' on y recherche la colonne dont la première ligne contient "Code OF"
   numcol = Application.IfError(Application.Match("Code OF", Rows(1), 0), 0)
   ' si la colonne "Code OF" n'est pas trouvée, on quitte la Sub
   If numcol = 0 Then MsgBox "Erreur : Pas de colonne 'Code OF'": Exit Sub
   ' on va remplacer au sein de la colonne numcol, le texte "AD-DEBUT" par la valeur d'erreur #N/A
   Columns(numcol).Replace what:="AD-DEBUT", replacement:="#N/A", LookAt:=xlWhole, MatchCase:=False
   ' on va remplacer au sein de la colonne numcol, le texte "AD-DEBUT" par la valeur d'erreur #N/A
   Columns(numcol).Replace what:="HNONP", replacement:="#N/A", LookAt:=xlWhole, MatchCase:=False
   ' on trie les lignes selon la colonne numcol
   Range("a1").CurrentRegion.Sort key1:=Cells(1, numcol), order1:=xlAscending, Header:=xlYes
   On Error Resume Next    'si on ne trouve pas la valeur d'erreur dans la colonne numcol,
                           'SpecialCells retourne une erreur, cette instruction permet de continuer
                           'l'exécution
   'on recherche toute les cellules avec valeur d'erreur dans la colonne numcol
   Set p = Columns(numcol).SpecialCells(xlCellTypeConstants, xlErrors)
   On Error GoTo 0
   ' si p n'est pas vide, on supprime toutes les lignes de p
   If Not p Is Nothing Then p.EntireRow.Delete
   Set p = Nothing   'important pour la prochaine recherche 'SpecialCells'
      
   '========================================================================================================
   '========================  suppression de "Salarié (code)" différent de "MACHINSEUL"  ===================
   '========================================================================================================
      ' on trie la feuille selon la colonne "Salarié (code)"
   ' on y recherche la colonne dont la première ligne contient "Code OF"
   numcol = Application.IfError(Application.Match("Salarié (code)", Rows(1), 0), 0)
   ' si la colonne "Code OF" n'est pas trouvée, on quitte la Sub
   If numcol = 0 Then MsgBox "Erreur : Pas de colonne 'Salarié (code)'": Exit Sub
   Range("a1").CurrentRegion.Sort key1:=Cells(1, numcol), order1:=xlAscending, Header:=xlYes
   'on va rechercher la première cellule à partir du bas qui contient "MACHINSEUL"
   On Error Resume Next
   Set Der = Columns(numcol).Find("MACHINSEUL", after:=Cells(Rows.Count, numcol), LookAt:=xlWhole, LookIn:=xlValues, SearchDirection:=xlPrevious)
   'on supprime à partir de la ligne de la cellule plus une
   If Not Der Is Nothing Then Range(Der.Offset(1), Cells(Rows.Count, numcol)).EntireRow.Delete
  
   'on va rechercher la première cellule à partir du haut qui contient "MACHINSEUL"
   On Error Resume Next
   Set Prem = Columns(numcol).Find("MACHINSEUL", after:=Cells(Rows.Count, numcol), LookAt:=xlWhole, LookIn:=xlValues, SearchDirection:=xlNext)
   'on supprime à partir de la ligne 2 jusqu'à la ligne de la cellule moins une
   If Not Prem Is Nothing Then Range(Cells(2, numcol), Prem.Offset(-1)).EntireRow.Delete
   ' on supprime les en-têtes
  
   Rows("1:1").Delete Shift:=xlUp
  
   '========================================================================================================
   '========================  Temps salariés  ==========================================================
   '======================================================================================================
  
   Sheets("Temps salariés").Select      'on sélectionne la feuille "Temps salariés"
   ' on y recherche la colonne dont la première ligne contient "Code OF"
   numcol = Application.IfError(Application.Match("Code OF", Rows(1), 0), 0)
   ' si la colonne "Code OF" n'est pas trouvée, on quitte la Sub
   If numcol = 0 Then MsgBox "Erreur : Pas de colonne 'Code OF'": Exit Sub
   ' on va remplacer au sein de la colonne numcol, le texte "AD-DEBUT" par la valeur d'erreur #N/A
   Columns(numcol).Replace what:="AD-DEBUT", replacement:="#N/A", LookAt:=xlWhole, MatchCase:=False
   ' on va remplacer au sein de la colonne numcol, le texte "AD-DEBUT" par la valeur d'erreur #N/A
   Columns(numcol).Replace what:="HNONP", replacement:="#N/A", LookAt:=xlWhole, MatchCase:=False
   ' on trie les lignes selon la colonne numcol
   Range("a1").CurrentRegion.Sort key1:=Cells(1, numcol), order1:=xlAscending, Header:=xlYes
   On Error Resume Next    'si on ne trouve pas la valeur d'erreur dans la colonne numcol,
                           'SpecialCells retourne une erreur, cette instruction permet de continuer
                           'l'exécution
   'on recherche toute les cellules avec valeur d'erreur dans la colonne numcol
   Set p = Columns(numcol).SpecialCells(xlCellTypeConstants, xlErrors)
   On Error GoTo 0
   ' si p n'est pas vide, on supprime toutes les lignes de p
   If Not p Is Nothing Then p.EntireRow.Delete
   Set p = Nothing   'important pour la prochaine recherche 'SpecialCells'
  
   '============================== Supprime MACHINSEUL ====================================
  
   ' on y recherche la colonne dont la première ligne contient "Salarié (code)"
   numcol = Application.IfError(Application.Match("Salarié (code)", Rows(1), 0), 0)
   ' si la colonne "Code OF" n'est pas trouvée, on quitte la Sub
   If numcol = 0 Then MsgBox "Erreur : Pas de colonne 'Salarié (code)'": Exit Sub
   ' on va remplacer au sein de la colonne numcol, le texte "MACHINSEUL" par la valeur d'erreur #N/A
   Columns(numcol).Replace what:="MACHINSEUL", replacement:="#N/A", LookAt:=xlWhole, MatchCase:=False
   ' on trie les lignes selon la colonne numcol
   Range("a1").CurrentRegion.Sort key1:=Cells(1, numcol), order1:=xlAscending, Header:=xlYes
   On Error Resume Next    'si on ne trouve pas la valeur d'erreur dans la colonne numcol,
                           'SpecialCells retourne une erreur, cette instruction permet de continuer
                           'l'exécution
   'on recherche toute les cellules avec valeur d'erreur dans la colonne numcol
   Set p = Nothing
   Set p = Columns(numcol).SpecialCells(xlCellTypeConstants, xlErrors)
   On Error GoTo 0
   ' si p n'est pas vide, on supprime toutes les lignes de p
   If Not p Is Nothing Then p.EntireRow.Delete
  
    Rows("1:1").Delete Shift:=xlUp
  
  
   Application.ScreenUpdating = True
End Sub
 
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Re,

Un code long (et encore sans les commentaires, c'est beaucoup plus court) n'est pas synonyme d'inefficacité. Il peut-être bien plus rapide à l'exécution qu'un autre code beaucoup plus court.
Si ton fichier ne comporte que quelques centaines de lignes, on peut faire beaucoup plus court en code sans que la vitesse d'exécution ne soit pénalisante.
 

Anthonymctm

XLDnaute Occasionnel
Re,

Un code long (et encore sans les commentaires, c'est beaucoup plus court) n'est pas synonyme d'inefficacité. Il peut-être bien plus rapide à l'exécution qu'un autre code beaucoup plus court.
Si ton fichier ne comporte que quelques centaines de lignes, on peut faire beaucoup plus court en code sans que la vitesse d'exécution ne soit pénalisante.
Oui je comrpend, alors ça me va :)

Il ne me reste plus qu'une étape, j'ai besoin de positionner les différentes colonnes au bon endroit selon les titres de la ligne 1 et supprimer toutes les autres colonnes.

Date : colonne 1
Code OF : 2
Désignation : 3
Et ainsi desuite
Une collonne vide en 8
Code client : 9
Nom client : 10

Puis supprimer toutes les autres colonnes

J'aurais bien tenté un bricolage mais je sens que pour la partie suppression ça va pas le faire :(
 

Anthonymctm

XLDnaute Occasionnel
Re,

Voir le code dans module1 du fichier joint.

nota : on peut remplacer .Columns(numcol).Copy .Columns(1) par .Columns(numcol).Cut .Columns(1)
Excellent !

Tu avais déjà bossé dessus avant ou tu l'as faite juste pour moi ?
Parceque vu la rapidité.. Impressionnant.

J'ai presque finis mon fichier.
Et c'est un bon exercice parceque je pense qu'il y a plein de module qui pourront me reservir.

La dernière étape doit être simple, je vais essayer de faire ça moi-même.
En fin de macro je veux enregistrer chaque onglet dans un fichier excel à part en gardant le titre du fichier excel de base et en ajoutant le titre de l'onglet en question.
 

Anthonymctm

XLDnaute Occasionnel
Dans une vie antérieure, j'avais fait quelque chose d'approchant. Mais"numcol" m'a aidé.
hum.. J'ai dû changer la variable de mon côté, sinon j'avais un soucis de variable déjà déclarée

VB:
Dim numcol As Long, p As Range, plage As Range, Prem As Range, Der As Range, c As Range
    ' indiquez l'ordre des colonnes par leur en-têtes
' ##### pour une colonne vide
Const OrdreTS = "Date;Code OF;Titre cde;Salarié (code);#####;Opération (code);Temps h.;#####;Client (code);client"
Const OrdreTM = "Date;Code OF;Titre cde;#####;Salarié (code);Opération (code);Temps h.;#####;Client (code);client"
Dim s, numcol1&, i&, x
 

Anthonymctm

XLDnaute Occasionnel
Alors, je m'en sors à peu près.. mais pas tout à fait ^^'

J'ai trouvé une macro sur internet que j'ai adaptée à mon cas, ça fonctionne mais il me manque deux chose :
1- Ça me garde l'extension du fichier d'origine dans le nom du fichier donc j'obtiens :
"Anthonymctm-Extraction Metr Avril 20- v3.xlsm - Temps salariés.xls"

2- Ça m'ouvre le fichier Excel et ça le laisse ouvert, j'ai aucune utilité à ce qu'il reste ouvert

Si tu as des pistes :)
 

Discussions similaires

Réponses
2
Affichages
129