Sujet Précédent Sujet Suivant

Simplification macro mise en forme, tri et classement

Résolu/Fermé
Adirien Messages postés 84 Date d'inscription samedi 11 mai 2013 Statut Membre Dernière intervention 27 janvier 2024 - Modifié le 8 juil. 2023 à 20:40
yg_be Messages postés 23435 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 21 janvier 2025 - 19 juil. 2023 à 21:18

Bonjour,

J’ai réalisé une macro pour mettre en forme des données brutes copier sur un logiciel tiers (déplacement et suppression de colonnes, ajout de colonnes avec formule de calcul, mise en forme, tri de données pour classement par catégorie dans des feuilles différentes, etc…)

Précisions une fois le fichier mis en forme j’en conserve une copie et je retire à mesure les données qui ont été classées dans leur feuille respective car techniquement, une fois toute la procédure appliquée, il ne doit plus rester aucune ligne. Je l’ai volontairement fait pour ne pas passer à côté de cas particuliers qui ne rentrerait dans aucun des filtres appliqués.

Je ne suis pas un spécialiste du VBA donc je n’utilise pas forcément les procédures les plus simple ou les plus légères dans leur exécution, donc je voudrais faire appel à vos services si vous avez des conseils à me donner pour optimiser ce code où j’ai tendance parfois à me perdre. Je trouve qu’il contient beaucoup de répétitions qui pourrait surement être optimisé également.

Voici le code (il est particulièrement long mais en faite il faut surtout regarder les grandes étapes car comme je le dis c’est surtout beaucoup de répétitions) :

​
Sub mise_en_forme()


Dim Plage As Range
Dim start As Single
Dim Ecarts As String

start = Timer

Application.ScreenUpdating = False
'On Error Resume Next

'ETAPE 1 : Ajout de la feuille de comptage :

Sheets.Add.Name = "Ecarts"
Sheets("Ecarts").Activate
ActiveSheet.Paste
Ecarts = ActiveSheet.Name
With Sheets(Ecarts).Tab
        .Color = 255
        .TintAndShade = 0
      End With

 'ETAPE 2 : Tri personnalisé par ordre de colonne

ActiveSheet.Sort.SortFields.Add2 Key:=Range( _
        "A1:AL1"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "Numéro d'article,Groupe d'articles,Taille,Couleur,Entrepôt,Emplacement,Disponible,Compté" _
        , DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("A:AL")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With


' ETAPE 3 : Suppression des lignes ne contenant pas le mot PR1 dans la colonne Emplacement

 
    With ActiveSheet
       '  plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
            ' retrait des filtres s'il y en a
            ' application du filtre
        With .Range("A1")
            .AutoFilter Field:=6, Criteria1:="<>PR1"
            On Error Resume Next
                ' tentative de suppression des résultats
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                ' s'il n'y avait pas de résultat : on l'indique
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
            ' suppression des filtres
           .AutoFilter
        End With
    End With
    
  ' ETAPE 4 : Suppression des colonnes inutiles

    Range("H:H,J:AL").Delete
    
   ' ETAPE 5 : Ajout des colonnes et de leur formules
   
   Columns(1).Insert
  
   Range("A1").Value = "Utilisations"
   'Columns("A:A").ColumnWidth = 22
   Range("J1").Value = "Ecarts"
   Range("K1").Value = "2ème comptage"
   Range("L1").Value = "A saisir"
   
   'Mise en forme groupe d'article
   Range("B:B").NumberFormat = "00000"

   'Ajout formules
   Range("A2").FormulaR1C1 = "=VLOOKUP(RC[1],'N:\_INVENTAIRES\[Profil - utilisation.xlsx]tmpC314'!C1:C2,2,FALSE)"
   Range("J2").FormulaR1C1 = "=+RC[-1]-RC[-2]"
   Range("L2").FormulaR1C1 = "=+RC[-1]-RC[-3]"
   

    'Recopie formules
  derniereLigne = Cells(Rows.Count, 2).End(xlUp).Row
  Range("A2:A" & derniereLigne).FillDown
  Range("J2:J" & derniereLigne).FillDown
  Range("L2:L" & derniereLigne).FillDown
 
  ActiveSheet.Columns("A:L").AutoFit
  
  ' ETAPE 6 : Mise en forme tableau : bordure + titre gras
  
  With Range("A1").CurrentRegion
.Borders(1).LineStyle = 1 'tout les droites de toutes les cellules de la plage
.Borders(2).LineStyle = 1 'tout les gauches toutes les cellules de la plage
.Borders(3).LineStyle = 1 ' tout les tops de toutes les cellules de la plage
.Borders(4).LineStyle = 1 'tout les bottom de toutes les cellules de la plage
End With

  ' Mise en gras + centrer
  With Range("A1:L1")
  .Font.Bold = True
  .HorizontalAlignment = xlCenter
  End With
  
  'ETAPES 6 BIS : COPIE FEUILLE COMPTAGE MISE EN FORME AVANT RETRAIT DES ECARTS <>0
ActiveSheet.Copy Before:=ActiveSheet   ' copier la feuille après toutes les feuilles de calcul
ActiveSheet.Name = "Feuille_comptage"

  'ETAPE 7 : RETRAIT DES ECART DIFFERENT DE 0
  
   With Sheets(Ecarts)
       '  plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
            ' retrait des filtres s'il y en a
            ' application du filtre
        With .Range("A1")
           
            .AutoFilter Field:=10, Criteria1:="0"
            '.AutoFilter LaColonne, LeMot
            On Error Resume Next
                ' tentative de suppression des résultats
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                ' s'il n'y avait pas de résultat : on l'indique
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
            ' suppression des filtres
           .AutoFilter
        End With
    End With
    
  
  
  ' ETAPE 8 : Filtrer et copier les données pour classement par feuille
                     
                         'Filtrer et ajout feuille "Barrettes"
                         
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=1, Criteria1:="<>DORMANT COULISSANT"
    .AutoFilter Field:=3, Criteria1:="POL"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "Barrettes"
    Sheets("Barrettes").Paste
    Sheets("Barrettes").Columns("A:L").AutoFit
    
      ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
        With Sheets("Barrettes").Tab
        .Color = 5287936
        .TintAndShade = 0
      End With
    
                     'Filtrer et ajout feuille "Brut"
    
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=3, Criteria1:="PRB"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "Brut"
    Sheets("Brut").Paste
    Sheets("Brut").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
         With Sheets("Brut").Tab
        .Color = 5287936
        .TintAndShade = 0
      End With
      
                        'Filtrer et ajout feuille "Appro barretté"
                 
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=2, Criteria1:=("P6151")
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "Appro barretté"
    Sheets("Appro barretté").Paste
    Sheets("Appro barretté").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
        With Sheets("Appro barretté").Tab
        .Color = 5287936
        .TintAndShade = 0
      End With
    
                 'Filtrer et ajout feuille "Capots"
             
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=1, Criteria1:="DORMANT COULISSANT"
    .AutoFilter Field:=3, Criteria1:="POL"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "Capots"
    Sheets("Capots").Paste
    Sheets("Capots").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
        With Sheets("Capots").Tab
        .Color = 5287936
        .TintAndShade = 0
      End With
          
    
                    'Filtrer et ajout feuille "DC"
         
     With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=1, Criteria1:="DORMANT COULISSANT"
    .AutoFilter Field:=3, Criteria1:="PLA"
    .AutoFilter Field:=5, Criteria1:="<>KQ"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "DC"
    Sheets("DC").Paste
    Sheets("DC").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
    With Sheets("DC").Tab
        .Color = 5287936
        .TintAndShade = 0
      End With
          
                        'Filtrer et ajout feuille "OC"
    
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=1, Criteria1:="OUVRANT COULISSANT"
    .AutoFilter Field:=3, Criteria1:="PLA"
    .AutoFilter Field:=5, Criteria1:="<>KQ"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "OC"
    Sheets("OC").Paste
    Sheets("OC").Columns("A:L").AutoFit
    
     ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
        With Sheets("OC").Tab
        .Color = 5287936
        .TintAndShade = 0
      End With
      
                        'Filtrer et ajout feuille "DF"
    
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=1, Criteria1:="DORMANT FRAPPE"
    .AutoFilter Field:=3, Criteria1:="PLA"
    .AutoFilter Field:=5, Criteria1:="<>KQ"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "DF"
    Sheets("DF").Paste
    Sheets("DF").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
    With Sheets("DF").Tab
        .Color = 5287936
        .TintAndShade = 0
      End With
    
      
                'Filtrer et ajout feuille "ANM"
    
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=1, Criteria1:="ADDITIF_NON_MONTE"
    .AutoFilter Field:=3, Criteria1:="PLA"
    .AutoFilter Field:=5, Criteria1:="<>KQ"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "ANM"
    Sheets("ANM").Paste
    Sheets("ANM").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
    With Sheets("ANM").Tab
        .Color = 5287936
        .TintAndShade = 0
    End With
    'Filtrer et ajout feuille "ADD"
        
     With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=1, Criteria1:="ADDITIF FRAPPE"
    .AutoFilter Field:=3, Criteria1:="PLA"
    .AutoFilter Field:=5, Criteria1:="<>KQ"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "ADD"
    Sheets("ADD").Paste
    Sheets("ADD").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
    With Sheets("ADD").Tab
        .Color = 5287936
        .TintAndShade = 0
    End With
    
      'Filtrer et ajout feuille "KQ"
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=3, Criteria1:="PLA"
    .AutoFilter Field:=5, Criteria1:="KQ"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "KQ"
    Sheets("KQ").Paste
    Sheets("KQ").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
        With Sheets("KQ").Tab
        .Color = 5287936
        .TintAndShade = 0
    End With
    
         'Filtrer et ajout feuille "ADD2"
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=1, Criteria1:="ADDITIF FRAPPE"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "ADD2"
    Sheets("ADD2").Paste
    Sheets("ADD2").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
        With Sheets("ADD2").Tab
        .Color = 15773696
        .TintAndShade = 0
    End With
    
             'Filtrer et ajout feuille "DF2"
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=1, Criteria1:="DORMANT FRAPPE"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "DF2"
    Sheets("DF2").Paste
    Sheets("DF2").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
        With Sheets("DF2").Tab
        .Color = 15773696
        .TintAndShade = 0
    End With
     
             'Filtrer et ajout feuille "OF"
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=1, Criteria1:="OUVRANT KLF*"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "OF"
    Sheets("OF").Paste
    Sheets("OF").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
        With Sheets("OF").Tab
        .Color = 15773696
        .TintAndShade = 0
    End With
    
                 'Filtrer et ajout feuille "DC2"
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=1, Criteria1:="DORMANT COULISSANT"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "DC2"
    Sheets("DC2").Paste
    Sheets("DC2").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
        With Sheets("DC2").Tab
        .Color = 15773696
        .TintAndShade = 0
    End With
         
 'Filtrer et ajout feuille "OC2"
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=1, Criteria1:="OUVRANT COULISSANT"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "OC2"
    Sheets("OC2").Paste
    Sheets("OC2").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
        With Sheets("OC2").Tab
        .Color = 15773696
        .TintAndShade = 0
    End With
    
    Sheets("Ecarts").Move Before:=Sheets("KQ")
    
    MsgBox "durée du traitement: " & Timer - start & " secondes"

End Sub

​

Merci pour votre aide
Windows / Chrome 109.0.0.0

A voir également:

3 réponses

Réponse 1 / 3
yg_be Messages postés 23435 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 21 janvier 2025 Ambassadeur 1 559
7 juil. 2023 à 11:21

bonjour,

montre nous plutôt deux sections de code répétitives, en mettant les différences en évidence.

Une technique habituelle, c'est de créer une sub avec des paramètres.
1
Réponse 2 / 3
Adirien
Modifié le 8 juil. 2023 à 20:42

Voici un exemple où dans un bloc il y'a une partie qui contient des éléments variable mais où la procédure est identique. Et la seconde partie du bloc, elle ne contient pas d'élément variable et est strictement identique et là je pourrais éventuellement sortir cette partie dans un autre Sub

Bloc 1 : 

Nom de feuille et critères du filtre variables

'Filtrer et ajout feuille "KQ"
    With Sheets(bdd).Range("A1")
    .AutoFilter Field:=3, Criteria1:="PLA"
    .AutoFilter Field:=5, Criteria1:="KQ"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "KQ"
    Sheets("KQ").Paste
    Sheets("KQ").Columns("A:L").AutoFit

Procédure identique :

  ' Suppression des données copiées de la feuille initiale
      
       With Sheets(bdd)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(bdd).ShowAllData
        With Sheets("KQ").Tab
        .Color = 5287936
        .TintAndShade = 0
    End With

Bloc 2 :

Nom de feuille et critères du filtre variables :

'Filtrer et ajout feuille "ADD"
        
     With Sheets(bdd).Range("A1")
    .AutoFilter Field:=1, Criteria1:="ADDITIF FRAPPE"
    .AutoFilter Field:=3, Criteria1:="PLA"
    .AutoFilter Field:=5, Criteria1:="<>KQ"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "ADD"
    Sheets("ADD").Paste
    Sheets("ADD").Columns("A:L").AutoFit

Procédure identique :

       With Sheets(bdd)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(bdd).ShowAllData
    With Sheets("ADD").Tab
        .Color = 5287936
        .TintAndShade = 0
    End With

J'ai 15 blocs comme ça qui occupe 75% du volume total de la macro donc c'est sur que si je peux gagner là dessus la macro serait tout de suite plus digeste. Surtout si je veux modifier ou faire évoluer des choses pour éviter de répéter 15 fois la même modification.
0
yg_be Messages postés 23435 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 21 janvier 2025 1 559
7 juil. 2023 à 12:32

suggestion:

Option Explicit
Dim bdd As String
Sub mise_en_forme()
'...
Call repet("KQ", "", "PLA", "KQ")
Call repet("ADD", "ADDITIF FRAPPE", "PLA", "<>KQ")
'...
End Sub
Private Sub repet(fl As String, crit1 As String, crit3 As String, crit5 As String)
Dim Plage As Range
'Filtrer et ajout feuille
    With Sheets(bdd).Range("A1")
    If crit1 <> "" Then
        .AutoFilter Field:=1, Criteria1:=crit1
    End If
    .AutoFilter Field:=3, Criteria1:=crit3
    .AutoFilter Field:=5, Criteria1:=crit5
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = fl
    Sheets(fl).Paste
    Sheets(fl).Columns("A:L").AutoFit
    ' Suppression des données copiées de la feuille initiale
      
       With Sheets(bdd)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(bdd).ShowAllData
        With Sheets(fl).Tab
        .Color = 5287936
        .TintAndShade = 0
    End With
End Sub
1
Adirien > yg_be Messages postés 23435 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 21 janvier 2025
7 juil. 2023 à 20:07

Je m'excuse je ne veux pas juste copier coller un bout de code sans le comprendre. 

Je ne suis pas sur de comprendre son fonctionnement, surtout la 1ère partie, si tu as une explication brève ? 

0
yg_be Messages postés 23435 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 21 janvier 2025 1 559 > Adirien
7 juil. 2023 à 21:49

Connais-tu les concepts d'appel de routine et de passage de paramètres?  Sinon, difficile de te faire ici un cours à ce sujet.

1
Adirien Messages postés 84 Date d'inscription samedi 11 mai 2013 Statut Membre Dernière intervention 27 janvier 2024 2 > Utilisateur anonyme
10 juil. 2023 à 18:15

Oui j'ai fais en mode pas à pas avec et sans Option Explicit, c'est pour cela que je m'interrogais sur ce point. 

1
yg_be Messages postés 23435 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 21 janvier 2025 1 559 > Adirien Messages postés 84 Date d'inscription samedi 11 mai 2013 Statut Membre Dernière intervention 27 janvier 2024
11 juil. 2023 à 18:27

Inutile si elle reste inutilisée.

Je ne peux pas te conseiller à propos de l'automatisation de la mise en page, je n'ai pas d'expérience avec cela.

1
Réponse 3 / 3
Utilisateur anonyme
Modifié le 8 juil. 2023 à 18:42

Bonjour 

étaient déclaré dans le private Sub ? 

si ce que tu nonnes "le private sub" c'est la ligne 1 de ta routine, alors on va faire un petit point terminologique.

Cette ligne s'appelle la déclaration d'une procédure ou d'une fonction.

Elle comporte plusieurs éléments. D'abord son type, si c'est une sub ben c'est juste une sub, si c'est une fonction alors c'est une fonction du type de son résultat, par exemple, une fonction qui calcule le carré d'un nombre entier sera une fontion entière.

Pivate est un modificateur de visibilité, clest optionnel, mais très conseillé et il s'ecrit au début de la ligne, ta procédure privée n'est visible qu'à l'intérieur et de ton module.

Ensuite, y'a le nom que tu lui as donné.

Et enfin les paramètres, la liste des variables et de leur types qui vont transmettre une information à la routine.

Tout paramètre passé à la routine est déclaré, mais comme l'a dit yg_be que je salue, f1 ne l'est pas, c'est fl.

En vba je ne suis pas sûr, mais c'est le cas pour d'autres langages (dont d'autres vb), on peut écrire 2 routines avec le même nom, à condition que le nombre ou le type des paramètres change. On parle alors de signature. Le nom et la liste des paramètres constituent la signature et  tant que les signatures sont différentes le compilateur sait laquelle il doit exécuter.

Si j'ai une fonction entière qui prend en paramètre un nombre entier et une fonction décimale qui prend en paramètre un nombre décimal et qu'elle s'appellent toutes les 2 carrés.

Au momment où j'écris 

Toto = Carre(2.3)

Le compilateur choisir la bonne.

Le type de retour ne fait pas partie de la signature car il peut y avoir de conversion possible.

Je peux très bien stocker un entier dans une variable décimale.

PS, pour tes prochains posts, merci de choisir "basic" pour la.coloration syntaxique 
0
Adirien Messages postés 84 Date d'inscription samedi 11 mai 2013 Statut Membre Dernière intervention 27 janvier 2024 2
Modifié le 8 juil. 2023 à 19:31

Merci pour ces précisions et bien vu pour le f1/fl que j'ai confondu. 

0

Discussions similaires

document html
Utilisateur anonyme -
brucine -

1 réponse
Tri les lettres d'un mot par ordre alphabétique
labejau37 -
DjiDji59430 -

9 réponses
Encadrement d'un Titre intégré au cadre
Ced -
Ced -

2 réponses