[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
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:
 
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
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)
 

Pièces jointes

  • Anthonymctm-Extraction Metr Avril 20- v2.xlsm
    61.5 KB · Affichages: 2

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
 

Discussions similaires

Réponses
2
Affichages
129

Statistiques des forums

Discussions
311 725
Messages
2 081 947
Membres
101 849
dernier inscrit
florentMIG