comment adapter une macro aux données qui changent

M

michel90

XLDnaute Nouveau
Bonjour,

je vous explique mon soucis. j'ai développé une macro avec l'enregistreur de macro.
cette macro permet de traiter un fichier c'est a a dire filtré des colonne supprimer des ligne mettre des cellule en rouge! mais tout ça avec des condition. pour le moment elle marche très bien.
Mais cette macro sera utilisé tout les jours ce qui fait j'en suis sûr qu’elle va pas fonctionner demain sur le nouveau fichier qu'elle va traiter, elle va généré des erreurs. car les données vont changer
cependant j'ai envie que quelqu'un m’aide à la corrigé histoire quelle fonctionne chaque jour.
je vous remercie d'avance pour votre aide.

ci-dessous la macro

et le fichier qu'elle traite

VB: 
Sub Macrobeatrice()
'
' Macro1 Macro
'

' 1- stratut train = conçu potentiellment utilisable
' 1- si besoin de transport = annulé - non  défini et vide
    ActiveSheet.Range("$A$1:$O$280").AutoFilter Field:=5, Criteria1:= _
        "Conçu, potentiellement utilisable"
    ActiveSheet.Range("$A$1:$O$280").AutoFilter Field:=6, Criteria1:=Array( _
        "Annulé", "Non défini", "="), Operator:=xlFilterValues
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    Selection.AutoFilter
   
    '2-gorigine traçon = garder que les 87
      ActiveSheet.Range("$A$1:$O$217").AutoFilter Field:=7, Criteria1:=Array( _
        "71 | 116004 | 0 | IRUN", "80 | 140103 | 0 | MANNHEIM HGBF", _
        "80 | 253930 | 0 | SAARBRUCKEN RBF", "88 | 250076 | 0 | ANTWERPEN-NOORD", _
        "88 | 430009 | 0 | KINKEMPOIS", "88 | 940031 | 0 | GENT-ZEEHAVEN"), Operator:=xlFilterValues
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    Selection.AutoFilter
   
    '3- destination trançon
      ActiveSheet.Range("$A$1:$O$205").AutoFilter Field:=9, Criteria1:=Array( _
        "80 | 140236 | 0 | MANNHEIM RBF O/W", "80 | 253658 | 0 | VOLKLINGEN", _
        "88 | 110072 | 0 | SCHAERBEEK/SCHAARBEEK", "88 | 430009 | 0 | KINKEMPOIS", _
        "88 | 940031 | 0 | GENT-ZEEHAVEN"), Operator:=xlFilterValues
    Range("A100").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    Selection.AutoFilter
   
    '4- locomotive = garder ligne de roulement pententiellement disponible
       '- agent de conduite = garder journée de service
       '- sillon = garder sillon non conforme et sillon non rataché
      
       ActiveSheet.Range("$A$1:$O$199").AutoFilter Field:=13, Criteria1:=Array( _
        "Disponible", "Locomotive partiellement disponible", "="), Operator:= _
        xlFilterValues
    ActiveSheet.Range("$A$1:$O$199").AutoFilter Field:=14, Criteria1:=Array( _
        "Agent partiellement disponible", "Disponible", "="), Operator:=xlFilterValues
    ActiveSheet.Range("$A$1:$O$199").AutoFilter Field:=15, Criteria1:= _
        "=Sillon conforme", Operator:=xlOr, Criteria2:="="
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    Selection.AutoFilter
      
     '5- origine trançon et destinaton trançon
     'si deux cellules des deux colones sont identiques on supprime
     '=si(G2=I2;"oui";"non")
    
      Range("P1").Select
    ActiveCell.FormulaR1C1 = "bb"
    Range("P2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-9]=RC[-7],""oui"",""non"")"
    Range("P2").Select
    Selection.AutoFill Destination:=Range("P2:P148")
    Range("P2:P148").Select
    Range("P1").Select
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$P$148").AutoFilter Field:=16, Criteria1:="oui"
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    Selection.AutoFilter
    Columns("P:P").Select
    Selection.Delete Shift:=xlToLeft
      
     '6- heure depart et heure d'arriver
     ' calculer la diff entre heure d'arriver te heure de départ, si il est inférieur à 1 heure, on supprime les ligne
     '=SI(J2-H2<tempsval("1:00");"oui";"non")
     Range("P1").Select
    ActiveCell.FormulaR1C1 = "hh"
    Range("P2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-6]-RC[-8]<TIMEVALUE(""1:00""),""oui"",""non"")"
    Range("P2").Select
    Selection.AutoFill Destination:=Range("P2:P122")
    Range("P2:P122").Select
    Range("P1").Select
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$P$122").AutoFilter Field:=16, Criteria1:="oui"
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    Selection.AutoFilter
    Columns("P:P").Select
    Selection.Delete Shift:=xlToLeft
    Selection.AutoFilter
      
    '7- priorité applicable
     'mettre en gras et en rouge
      Range("D2").Select 'selection  de cellule 2 jusqu'a la fin
    Range(Selection, Selection.End(xlDown)).Select 'selection  de cellule 2 jusqu'a la fin
    Selection.Font.Bold = True
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Selection.AutoFilter
    '8- besoin de trabsport
     'si anulé mettre ne gras et rouge
    
     '9- locomotive
     'si ligne de roulement partiellement disponible
      'mettre les cellules en rouge
     
      ActiveSheet.Range("$A$1:$O$91").AutoFilter Field:=13, Criteria1:= _
        "Ligne de roulement partiellement disponible"
    Range("M:M").Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.AutoFilter
   
    '10- agent de conduite
     'SI journée de service partielement disponible
     'mettre les cellule en rouge
    
        ActiveSheet.Range("$A$1:$O$91").AutoFilter Field:=14, Criteria1:= _
        "Journée de service partiellement disponible"
    Range("N2").Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.AutoFilter
   
   
    '11 - Sillon
    'mettre en rouge les sillon non conforme et non rattaché
    ActiveSheet.Range("$A$1:$O$91").AutoFilter Field:=15, Criteria1:= _
        "=Sillon non conforme", Operator:=xlOr, Criteria2:="=Sillon non rattaché"
    Range("O2").Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.AutoFilter
   
    '12 rajouter une derniere colonne comentaire
     Range("P1").Select
    ActiveCell.FormulaR1C1 = "Commentaire"
    Range("P2").Select
    Columns("P:P").ColumnWidth = 26.29
   
    '13- statut train est conçu potentiellement utilisable
    'le besoin de transport deveint rouge et gras
    ActiveSheet.Range("$A$1:$P$91").AutoFilter Field:=5, Criteria1:= _
        "Conçu, potentiellement utilisable"
    Range("F34").Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    Selection.AutoFilter
End Sub
 

Pièces jointes

  • Copie de OT fichier base.xlsx
    35.1 KB · Affichages: 25
Trier par date Trier par votes
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Bonjour michel

Une proposition à adapter

VB: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Fitre As Range
If Not Intersect(Target, Columns("A:I")) Is Nothing Then
Filtre = ActiveCell.Offset(1, 0).Column
Application.ScreenUpdating = False
[A1:I37].AutoFilter Field:=Filtre, Criteria1:=ActiveCell, Operator:=xlAnd
End If
Cancel = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("K3:M38")) Is Nothing Then [A1:I37].AutoFilter
If Target.Count > 1 Then Exit Sub
End Sub
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Bonjour.
Je suppose que votre crainte est que vos ActiveSheet.Range(… ne couvrent pas toujours la partie filtrée de la feuille. Mettez PglFlt à la place, déclaré et initialisé comme dans cet exemple :
VB: 
Sub test()
Dim PlgFlt As Range
Set PlgFlt = ActiveSheet.AutoFilter.Range
MsgBox PlgFlt.Address
End Sub

Bonjour Lone-wolf
 
Dernière édition:
Vote positif 0 Vote négatif
M

michel90

XLDnaute Nouveau
Dranreb à dit:
Bonjour.
Je suppose que votre crainte est que vos ActiveSheet.Range(… ne couvrent pas toujours la partie filtrée de la feuille. Mettez PglFlt à la place, déclaré et initialisé comme dans cet exemple :
VB: 
Sub test()
Dim PlgFlt As Range
Set PlgFlt = ActiveSheet.AutoFilter.Range
MsgBox PlgFlt.Address
End Sub

Bonjour Lone-wolf
Cliquez pour agrandir...
bonjour, d'abord je te remercie pour ta réponse.
en effet ta solution elle marche. ce pendant , il me reste un dernier problème. c'es dans cette partie de ce code suivant, je veux qu'il filtre la colonne G et I et il supprime les ligne où la cellule ne commence pas par 87. car là il me garde les 88 et ça j'en veux pas. est ce que tu peux voir STP. Merci d'avance

VB: 
'2-gorigine traçon = garder que les cellule où ca commence par 87
      ActiveSheet.Range("$A$1:$O$217").AutoFilter Field:=7, Criteria1:=Array( _
        "71 | ", _
        "80 | ", _
        "88 | "), Operator:=xlFilterValues
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    Selection.AutoFilter
   
    '3- destination trançon = garder que les cellule où ca commence par 87
      ActiveSheet.Range("$A$1:$O$205").AutoFilter Field:=9, Criteria1:=Array( _
        "80 | ", _
        "88 | ", _
        "88 | "), Operator:=xlFilterValues
    Range("A100").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    Selection.AutoFilter
 
Vote positif 0 Vote négatif

Discussions similaires

Usine à gaz
  • Résolu(e)
XL 2021 Filtrage que je ne parviens pas à faire
Réponses
6
Affichages
578
Usine à gaz
Usine à gaz
chilo27
  • Question
Autres Simplifier une macro
Réponses
1
Affichages
366
fanch55
fanch55
D
  • Résolu(e)
Autres Problème de séléction de la dernière colonne + Filtre [VBA]
Réponses
2
Affichages
639
delsart59
D
Dadi147
  • Question
XL 2019 problème de code vba
Réponses
3
Affichages
569
vgendron
vgendron
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
AtTheOne
G
  • Question
Microsoft 365 Incompatibilité de type - Array
Réponses
2
Affichages
436
guiyom
G
dindin
  • Question
XL 2016 simplifier une macro enregistrée
Réponses
8
Affichages
711
dindin
dindin
R
  • Question
XL 2016 Rendre plus lisible un code VBA
2
Réponses
23
Affichages
2 K
TooFatBoy
TooFatBoy
I
  • Question
XL 2016 MACRO LENTE
Réponses
2
Affichages
836
ImNotJésus
I
P
  • Résolu(e)
XL 2016 4 étapes en 1 seule Excel vba
Réponses
4
Affichages
688
Pygos691
P

Membres actuellement en ligne

11 membres et 111 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 080
Messages
2 116 008
Membres
112 636
dernier inscrit
fred 1969