Microsoft 365 Macro Excel : supprimer des lignes en fonction de plusieurs critères

[benoitoleron]

Bonjour à tous,

J'ai fait une première demande sur un fil déjà résolu car je pensais à tort que ma demande était similaire, et que je pourrai adapter.

Staple1600 à donc déjà répondu comme un chef avec les info qu'il avait.

Cependant le problème n'était pas complet donc logiquement ça ne fonctionne pas.

Je suis débutant donc ma macro ne doit pas être optimisé mais cela fonctionne et ça me réjouis (oui j'ai presque fait une danse de la joie ) :

Je dois réaliser une macro pour mettre en forme des données issues d'un classeur crée par une extraction SAP.
Je vous joint les deux fichiers.
Le fichier 2020_03_19 Macro Tri DATA comporte une page sommaire avec les action déjà réalisés par la macro et ce qu'il reste à faire.

L'aide dont j'ai besoin c'est dans la suppression des lignes en fonction des certains critères, je ne maitrise pas assez VBA pour réaliser ces actions.
J'essaye d'apprendre mais moi pas comprendre vite VBA

Je sollicite donc ici votre aide, dont je vous remercie beaucoup.

PS : voici le code que Staple1600 à déjà réalisé qui fonctionne mais qui part ma faute n'est pas adapté à mon besoin (encore merci Staple1600):

Sub KeepOnly_CSTA()
Dim Plg As Range, pf As Range
Set Plg = Cells(1).Resize(Cells(Rows.Count, "J").End(3).Row, 13)
Plg.AutoFilter 10, "<>CSTA", xlAnd: Set pf = Range("_FilterDataBase")
Application.ScreenUpdating = False
pf.Offset(1, 0).Resize(pf.Rows.Count - 1).SpecialCells(12).EntireRow.Delete: Plg.AutoFilter
End Sub

 

[Staple1600]

Bonjour le fil, Beno17000 (re)

Beno17000
Reprécise (avec moult détails) dans le message
(et pas dans les PJ)
• quels sont les critères pour filtrer les lignes?
(dans l'autre fil, tu disais: supprimer tout ce qui n'est pas CSTA))
• quel fichier est concerné? son nom
• dans quel classeur sera la macro?
etc...

Plus tu donneras de détails et explications (dans le message), plus vite on pourra résoudre ta question

 

[benoitoleron]

Ok ça marche Staple1600

Ça tombe bien je viens d'avoir les précisions qui me manquaient...

Voilà pour le détail de ce qu'il me reste à faire et ou j'ai besoin de votre aide.
Merci par avance, et n'hésitez pas à me guider pour que j'apprenne à me débrouiller seul par la suite.
Le but n'est pas de vous faire faire ma macro mais de m'apprendre pour que je devienne un grand garçon.

Feuille de calcul dans Basis (1).xlsx = DATA extraites de SAP
2020_03_19 Macro Tri DATA.xlsm = Fichier de travail ou s'applique la macro activée par un bouton sur la feuille "Sommaire"

Dans la feuille FIFO j'ai besoin de :

- garder les lignes dont les valeurs comportent les caractères "OUV" dans la colonne K (prévoir les différentes type de polices min, maj, mix,...)​

- enlever les lignes dont les valeurs comportent les caractères "DEV" dans la colonne F (prévoir les différentes type de polices min, maj, mix,...)​

- enlever les lignes dont la colonne G a les caractères "V27" et la colonne H a les caractères "QRK" ( QRK sera modifié car c'est un nom donc modifié ici, et prévoir les différentes type de polices min, maj, mix,...)​

- Trier les données avec la colonne A "Arrivée" de manière croissante​

- Supprimer la colonne K​

- Encadrer chaque cellule​

- Colorer une ligne sur deux (transparent / gris clair(217,217,217))​

- Régler la largeur de des colonnes suivantes pour que toutes les infos soient visibles :​

Colonnes A, B, C, D, F, G, J​

- Largeur totale sur une page max en mode paysage, plusieurs pages à la suite​

​

Dans la feuille DEVIS j'ai besoin de :

- garder les lignes dont les valeurs comportent les caractères "OUV" dans la colonne K (prévoir les différentes type de polices min, maj, mix,...)​

- garder les lignes dont les valeurs comportent les caractères "DEV" dans la colonne F (prévoir les différentes type de polices min, maj, mix,...)​

- enlever les lignes dont la colonne G a les caractères "V27" (prévoir les différentes type de polices min, maj, mix,...)​

- Trier les données avec la colonne A "Arrivée" de manière croissante​

- Supprimer la colonne K​

- Encadrer chaque cellule​

- Colorer une ligne sur deux (transparent / gris clair(217,217,217))​

- Régler la largeur de des colonnes suivantes pour que toutes les infos soient visibles :​

Colonnes A, B, C, D, F, G, J​

- Largeur totale sur une page max en mode paysage, plusieurs pages à la suite​

​

Dans la feuille DEVIS ACCEPTE j'ai besoin de :

- garder les lignes dont les valeurs comportent les caractères "CSTA" dans la colonne J (prévoir les différentes type de polices min, maj, mix,...)​

- enlever les lignes dont la colonne F à le caractère "*"​

- Trier les données avec la colonne A "Date Acc. DEVIS" de manière croissante​

- Supprimer la colonne K​

- Encadrer chaque cellule​

- Colorer une ligne sur deux (transparent / gris clair(217,217,217))​

- Régler la largeur de des colonnes suivantes pour que toutes les infos soient visibles :​

Colonnes A, B, C, D, F, G, J​

- Largeur totale sur une page max en mode paysage, plusieurs pages à la suite​

​

Merci encore pour votre aide et encore une fois le but e d'apprendre pas de vous faire faire tout le boulot

 

[Staple1600]

Re

C'est bien de vouloir apprendre
C'est mieux de conserver les acquis
L'est où ma macro Sub KeepOnly_CSTA dans ton fichier?
Ils sont où tes essais/talonnements de modifs de ma macro?

 

[benoitoleron]

J'ai rien gardé car j'ai des erreurs et suite à tes remarques judicieuses j'ai tout remis bien propre au cas ou d'autres personnes viendrait aider.

Mais je peux reprendre et te dire là ou ça coince...

 

[Staple1600]

Re

J'ai rien gardé car j'ai des erreurs

Cela fait plaisir à lire...
PS: Il n'y avait aucune erreur, la macro faisait ce que tu demandais
(testé sur ton fichier exemple)
Tu permets, je vais m'isoler quelques minutes dans mon confinement pour sécher mes larmes.
Je suis tout chamboulé en dedans de moi.

 

[benoitoleron]

Pardon je me suis mal exprimé.

Ta macro fonctionne parfaitement avec les éléments que je t'ai donné.

J'ai essayé de prendre ta macro, puis de la coller dans mon fichier en essayant de la modifier mais je n'ai pas trouver comment l'adapter à mon fichier.
C'est de moi que vientt le problème pas de toi.

Tu as assuré grave soit rassuré.

 

[benoitoleron]

Edit du 02 avril 2020 9:30 : j'avais oublié cette nuit de détailler ce que je souhaitais dans le message.
(j'ai voulu faire vite hier soir mais ce matin sous la douche les idées claires me sont revenues..)

Bonjour à tous,

J'ai délaissé un peu le projet la semaine dernière car j'ai du aller déployer de nouveaux appareils au CHU de Tours pour les services de Réanimations dans le cadre du COVID-19...

Je reviens donc alors et j'ai pu avancer aujourd'hui sur le projet :

J'arrive à utiliser le code de Staple1600 (encore mille mercis) pour enlever des lignes dont on trouve dans une colonne la valeur égale à XXX ou enlever les lignes dont la valeurs n'est pas égales à XXX :

Sub KeepOnly_CSTA()
Dim Plg As Range, pf As Range
Set Plg = Cells(1).Resize(Cells(Rows.Count, "J").End(3).Row, 13)
Plg.AutoFilter 10, "<>CSTA", xlAnd: Set pf = Range("_FilterDataBase")
Application.ScreenUpdating = False
pf.Offset(1, 0).Resize(pf.Rows.Count - 1).SpecialCells(12).EntireRow.Delete: Plg.AutoFilter
End Sub

Par contre je dois utiliser plusieurs fois ce code à des moments différents dans ma macro et là je n'arrive pas sur ce code à faire les choses suivantes :

- j'ai une erreur si je recopie le code de Staple1600 à la ligne :
pf.Offset(1, 0).Resize(pf.Rows.Count - 1).SpecialCells(12).EntireRow.Delete: Plg.AutoFilter
- si le nombre de colonnes est différentes à adapter le code à la feuille.
- si la valeur souhaitée est variable mais contient à coup sur une série de caractères ABC et le reste varies.

Il me faut faire avec cette fonction les choses suivantes :

Dans la feuille nommée FIFO :
- garder les lignes dont les valeurs comportent les caractères "OUV" dans la colonne K (prévoir les différentes type de polices min, maj, mix,...)
- enlever les lignes dont les valeurs comportent les caractères "DEV" dans la colonne F (prévoir les différentes type de polices min, maj, mix,...)

Dans la feuille nommée DEVIS :
- garder les lignes dont les valeurs comportent les caractères "OUV" dans la colonne K (prévoir les différentes type de polices min, maj, mix,...)
- garder les lignes dont les valeurs comportent les caractères "DEV" dans la colonne F (prévoir les différentes type de polices min, maj, mix,...)

Dans la feuille nommée DEVIS ACCEPTEE :
- enlever les lignes comportant le caractère "*" dans la colonne F

Comme j'ai avancé sur mon fichier je vous mets la nouvelle version.

Je veux bien que l'on m'explique comment modifier le code de Staple1600 pour l'adapter à mon besoin.

Et d'avance merci pour votre aide.

PS : soyez indulgent sur mon code, j'ai fait au mieux de mes connaissances qui sont proches de zéro.
Il y'a surement mieux ou plus efficace mais c'est un début est j'ai globalement (en dehors de mon soucis) ce que je veux obtenir...
J'essaierai de l'améliorer dans un second temps....

 

[Staple1600]

Bonjour le fil, Beno17000

•>Beno17000
(Suis toujours confiné, donc avec du temps libre
Essaie cette version "améliorée"

Sub exemple_b()
Dim T, Plg As Range, A_COPIER As Range, Choix_Fic, WBK As Workbook, f As Worksheet
Dim pf As Range, Plg2 As Range, fD As Worksheet
'On efface les données précédentes
Set fD = Sheets("DATA")
T = Array("FIFO", "DEVIS", "DEVIS ACCEPTE"): fD.Range("A:AB").Clear
Set Plg = Worksheets("FIFO").Range("A:J"): Plg.Clear: Sheets(T).FillAcrossSheets Plg
With Application
    .ScreenUpdating = False
    'Choix du fichier Source
    Choix_Fic = .GetOpenFilename(Title:="Choisir le classeur Source", FileFilter:="Classeur XL (*.xls*),*xls*")
        If Choix_Fic <> False Then
            Set WBK = Workbooks.Open(Choix_Fic): Set f = WBK.Sheets(1)
            Set A_COPIER = Intersect(f.UsedRange.EntireRow, f.[A:AB]): A_COPIER.Copy fD.Cells(1): WBK.Close False
        End If
    .CutCopyMode = False
End With
fD.Columns("A:AB").EntireColumn.AutoFit: fD.[A1:AB1].Font.Bold = -1
With fD.UsedRange
.Font.Size = 12: .Interior.Color = xlNone
End With
Dim fOP As Range
With Application
    .ScreenUpdating = False: Set fOP = Sheets("FIFO").Cells(1)
'On garde dans la colone I toutes les valeurs SAUF V27
    Set Plg2 = Intersect(fD.UsedRange.EntireRow, fD.[A:AB]): Plg2.AutoFilter 9, "=V27", xlAnd
    Set pf = fD.Range("_FilterDataBase")
    pf.Offset(1, 0).Resize(pf.Rows.Count - 1).SpecialCells(12).EntireRow.Delete: fD.ShowAllData: fD.AutoFilterMode = False
'réagencement des colonnes sur FIFO
    Dim LCol As Variant, N_Col As Variant, vFIFO, Dlg&, X&
    Dlg = fD.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
    Const SwapCol As String = "AA,B,L,A,E,I,S,P,T,H": LCol = Split(SwapCol, ",")
    ReDim N_Col(1 To UBound(LCol) + 1)
    For X = 0 To UBound(LCol): N_Col(X + 1) = fD.Columns(LCol(X)).Column: Next
    fOP.Resize(Dlg, UBound(LCol) + 1) = .Index(fD.Cells, Evaluate("ROW(1:" & Dlg & ")"), N_Col)
    fOP.Resize(Dlg, UBound(LCol) + 1).Columns.AutoFit: Sheets("FIFO").Range("A:A,I:I").NumberFormat = "m/d/yyyy"
'Renommer les en-têtes de la feuille FIFO des colonnes A, D, E, G
    fOP = "Arrivée": fOP(1, 4) = "N° de Série": fOP(1, 5) = "Type App": fOP(1, 7) = "TyT"
    vFIFO = Sheets("FIFO").Cells(1).CurrentRegion.Value
' "Copie/Colle" les données de FIFO dans la feuille DEVIS
    Sheets("DEVIS").Cells(1).Resize(UBound(vFIFO, 1), UBound(vFIFO, 2)) = vFIFO
    Sheets("DEVIS").Range("A:A,I:I").NumberFormat = "m/d/yyyy"
    Sheets("DEVIS").[A1] = "Acc. Devis": Sheets("DEVIS").[J1] = "Statut"
    .ScreenUpdating = True
End With
End Sub

Pour tester, seul le classeur contenant la macro doit être ouvert.
NB: Comme c'est un test, tu copies le code dans un nouveau module
et tu lances la macro par Affichage/Macros/exemple_b [Exécuter]
Soit tu ajoutes un bouton sur la feuille Sommaire auquel tu affectes cette macro.
PS: Les commentaires en vert t'indiquent où je me suis arrêté dans les modifs de ta macro exemple.

 

[benoitoleron]

Merci Staple1600,

C'est super plus rapide que ma macro. MERCI

Je vais retravailler ton code car lorsque je l’exécute j'ai des choses qui ne sont pas réalisées.

 

[Staple1600]

Re

Je vais retravailler ton code car lorsque je l’exécute j'ai des choses qui ne sont pas réalisées.

Merci de lire attentivement mes messages !

PS: Les commentaires en vert t'indiquent où je me suis arrêté dans les modifs de ta macro exemple.

*: j'ai mis il parce que je a dit, c'est pas français

 

[benoitoleron]

Pardon pardon monsieur pas taper moi.

J'ai lut trop vite pardon

Allez vient je te paye un café

 

[benoitoleron]

Bon je suis une buse je n'y arrive pas trop...

 

[Staple1600]

Re

•>Beno1700
C'est normal et c'est bien d'échouer
Comme disait, maître Yoda
L'échec, le meilleur des maîtres, être
Et qui dit Yoda sur XLD, aussitôt pense Victor21
que je cite donc, citant N. Boileau
"Hâtez-vous lentement, et sans perdre courage,
Vingt fois sur le métier remettez votre ouvrage,
Polissez-le sans cesse, et le repolissez,
Ajoutez quelquefois, et souvent effacez."

 

[benoitoleron]

Bon j'avance. mais je ne suis pas certain que tu aimes beaucoup ce que j'ai fait...

Je ne sais pas comment faire pour dans les feuille suivantes :

- Feuille FIFO garder les lignes dont la colonne K (avant sa suppression) contient les caractères OUV
- Feuille FIFO supprimer les lignes dont la colonne F désignation contient les caracteres DEV

- Feuille DEVIS garder les lignes dont la colonne K (avant sa suppression) contient les caractères OUV
- Feuille DEVIS garder les lignes dont la colonne F désignation contient les caracteres DEV

- Feuille DEVIS ACCEPTE supprimer les lignes dont la colonne F contient le caractère *

Bon café?