Résolu Résolu [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.
 
Ce fil a été résolu! Aller à la solution…

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @Anthonymctm,

L'expression suivante renvoie le numéro de la colonne ou bien 0 si "Code OH" ne figure pas dans la première ligne de la feuille active:
VB:
application.iferror(application.match("Code OF",rows(1),0),0)
 
Dernière édition:

Anthonymctm

XLDnaute Occasionnel
Bonjour mapomme et merci pour ta réponse, j'ai essayé
Set plage = Application.IfError(Application.Match("Code OF", Rows(1), 0), 0)

Mais ça me renvoi une erreur
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Mais ça me renvoi une erreur
Jamais je n'ai dit que ça retournait une plage. J'ai dit que ça retournait le numéro de la colonne.
donc, on peut faire :
VB:
NumCol = application.iferror(application.match("Code OF",rows(1),0),0)
if numcol > 0 then
   set plage = columns(numcol)
else
   msgbox "Erreur : Pas de colonne 'Code OF'"
   exit sub
endif
edit:
 
Ce message a été identifié comme étant une solution!
Dernière édition:

Anthonymctm

XLDnaute Occasionnel
Mapomme,

Je rencontre quelques soucis différent, dis moi si je dois refaire un topic à part, je parviens pas le résoudre.

J'ai repris une macro que j'avais dans un autre fichier et qui me permettait de masquer des lignes selon le contenu d'une cellule de la ligne.

Je parviens à exécuter la macro modifiée pour la supprimer.
Mais si je dupplique la macro, ça ne fonctionne plus. (ça me dit la méthode 'Union' de l'objet '_Global a échoué puis Set p = Union(p, cel.MergeArea) est surligné à la ligne 29)
Note: dans le fichier initial, la cellule de test pouvait être fusionnée

la macro en question :
VB:
im p As Range, plage As Range
  
       numcol = Application.IfError(Application.Match("Code OF", Rows(1), 0), 0)
        If numcol > 0 Then
          Set plage = Columns(numcol)
        Else
          MsgBox "Erreur : Pas de colonne 'Code OF'"
          Exit Sub
        End If
            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
        
  Sheets("Temps salariés").Select
    Range("A2").Select
    
           numcol = Application.IfError(Application.Match("Salarié (code)", Rows(1), 0), 0)
If numcol > 0 Then
   Set plage = Columns(numcol)
Else
   MsgBox "Erreur : Pas de colonne 'Salarié (code)'"
   Exit Sub
End If
    With plage
        For Each cel In plage.Cells
            If cel = "MACHINSEUL" Then If p Is Nothing Then Set p = cel Else Set p = Union(p, cel.MergeArea)
        Next
    End With
  p.EntireRow.Delete
 
  Sheets("Temps salariés").Select
    Range("A2").Select
    
           numcol = Application.IfError(Application.Match("Salarié (code)", Rows(1), 0), 0)
If numcol > 0 Then
   Set plage = Columns(numcol)
Else
   MsgBox "Erreur : Pas de colonne 'Salarié (code)'"
   Exit Sub
End If
    With plage
        For Each cel In plage.Cells
            If cel <> "MACHINSEUL" Then If p Is Nothing Then Set p = cel Else Set p = Union(p, cel.MergeArea)
        Next
    End With
  p.EntireRow.Delete
 

Anthonymctm

XLDnaute Occasionnel
LA macro initiale qui fonctionne bien est celle-ci :
VB:
Sub Masquer_D()
    Dim p As Range, plage As Range
    Application.ScreenUpdating = False
    Set plage = Range("Descriptif!N1:N250")
    With plage
        For Each cel In plage.Cells
            If cel = "0" Then If p Is Nothing Then Set p = cel Else Set p = Union(p, cel.MergeArea)
        Next
    End With
 p.EntireRow.Hidden = True 'ligne a débloquer
 Application.ScreenUpdating = True
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonsoir @Anthonymctm :),
  1. vous examinez toutes les cellules des colonnes - c'est contre productif au possible
  2. vous utilisez la fonction UNION qui est gourmande en temps de calcul
  3. sans avoir le fichier qui plante, je ne peux rien dire
 

Anthonymctm

XLDnaute Occasionnel
Re,

Une version v2 qui ne plantera pas si il y a beaucoup de lignes dispersées à supprimer et beaucoup plus rapide dans ce cas que la v1.
(Si l'ordre final des lignes ne vous convient pas, alors me préciser comment doivent être triées les feuilles après suppression des lignes)
Wow, mais t'as carrément tout revu !
Il me faudra un peu de temps pour voir tout ça je vais essayer de te répondre dans le weekend.
Merci en tout cas :)
 

Anthonymctm

XLDnaute Occasionnel
Bonjour Mapomme,

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.

Est-ce que tu peux m'expliquer pourquoi tu tries les données ?
 

Anthonymctm

XLDnaute Occasionnel
Re,

Une version v2 qui ne plantera pas si il y a beaucoup de lignes dispersées à supprimer et beaucoup plus rapide dans ce cas que la v1.
(Si l'ordre final des lignes ne vous convient pas, alors me préciser comment doivent être triées les feuilles après suppression des lignes)
Re-Bonjour Mapomme,
Je pense avoir réussi à faire tout ce dont j'ai besoin, il ne me manque plus qu'à supprimer toutes les lignes dont code salarié n'est pas égale à "machinseul" sur l'onglet temps machine.

(En fait, j'ai besoin de séparer ses lignes d'un onglet à l'autre, sur l'un je les supprime, sur l'autre je ne garde qu'eux)

Le trie pose problème pour ensuite supprimer la ligne des titres

Le code :
VB:
Option Explicit

Sub Clean()
   Dim numcol As Long, p As Range, plage As Range
  
   Sheets("Feuil1").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
   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 supprimme toutes les lignes de p
   If Not p Is Nothing Then p.EntireRow.Delete
   Set p = Nothing   'important pour la prochaine recherche 'SpecialCells'
  
   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"
  
  
    Sheets("Temps salariés").Select      'on sélectionne la feuille "Temps salariés"
   ' 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 'Code OF'": 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
   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 'On efface la première ligne
    
      
   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("Salarié (code)", Rows(1), 0), 0)
   ' si la colonne "Salarié (code)" 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 "AD-DEBUT" 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
   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 supprimme toutes les lignes de p
   If Not p Is Nothing Then p.EntireRow.Delete
   Set p = Nothing   'important pour la prochaine recherche 'SpecialCells'
  
      Cells.Replace What:="MACHINSEUL", Replacement:="TCI", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
   Rows("1:1").Delete Shift:=xlUp 'On efface la première ligne
  
 
  
  Application.ScreenUpdating = True
End Sub
 

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 :(
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas