Discussion :

[Muzzik]

Bonjour a tous,

Je dois adapter une macro qui n'est pas de mon travail, j'apprends comme beaucoup mais j'aimerai comprendre.

Celle ci est destiné a être utilisé sur un fichier volumineux que je reçois mensuellement, sa forme diffère (nombre de lignes, contenus).
Initialement il pèse entre 120/130 Mo sur 2 onglets de 1 048 500 lignes.

Je dois épurer celui en supprimant les doublons (la macro fonctionne), les lignes des produits qui ne m'intéresse pas (la je bloque).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Sub supprimedoublons()
 
Dim G1 As Worksheet
Dim G2 As Worksheet
Dim PL As Range 'déclare la variable PL (PLage)
Dim PLU As Range 'déclare la variable O (PLage Utile)
 
Workbooks("test CFA macro.xlsm").Activate 'active le classeur GPL CISCO.xlsx
Set G1 = ActiveWorkbook.Worksheets("Glemea1") 'définit l'onglet G1
Set G2 = ActiveWorkbook.Worksheets("Glemea2") 'définit l'onglet G2
If G2.FilterMode = True Then G2.ShowAllData 'si G2 est filtrée, supprime le filtre
If G1.FilterMode = True Then G1.ShowAllData 'si G2 est filtrée, supprime le filtre
 
G1.Range("$A:$F").RemoveDuplicates Columns:=Array(3, 4), Header:=xlYes 'supprime les doublons des colonne C et D dansl'onglet G1
G2.Range("$A:$F").RemoveDuplicates Columns:=Array(3, 4), Header:=xlYes 'supprime les doublons des colonne C et D dansl'onglet G2
 
Set PL = G1.Range("A1").CurrentRegion 'définit la plage PL (onglet G1)
Set PLU = PL.Offset(1, 0).Resize(PL.Rows.Count - 1, PL.Columns.Count) 'définit la plage utile PLU (sans la première ligne de PL)
PL.AutoFilter Field:=4, Criteria1:="=*refu*", Operator:=xlOr, Criteria2:="=*remanu*" 'filtre les 2 cas dans la colonne D
PLU.SpecialCells(xlCellTypeVisible).EntireRow.Delete 'supprime les lignes visibles de la plage utile PLU
G1.ShowAllData 'supprime le filtre
 
Set PL = G1.Range("A1").CurrentRegion 'définit la plage PL (onglet G1)
Set PLU = PL.Offset(1, 0).Resize(PL.Rows.Count - 1, PL.Columns.Count) 'définit la plage utile PLU (sans la première ligne de PL)
PL.AutoFilter Field:=3, Criteria1:="=*CON-NC*" 'filtre le cas dans la colonne D
PLU.SpecialCells(xlCellTypeVisible).EntireRow.Delete 'supprime les lignes visibles de la plage utile PLU
G1.ShowAllData 'supprime le filtre
 
Set PL = G2.Range("A1").CurrentRegion 'définit la plage PL (onglet G2)
Set PLU = PL.Offset(1, 0).Resize(PL.Rows.Count - 1, PL.Columns.Count) 'définit la plage utile PLU (sans la première ligne de PL)
PL.AutoFilter Field:=3, Criteria1:="=*CON-NC*" 'filtre le cas colonne D
PLU.SpecialCells(xlCellTypeVisible).EntireRow.Delete 'supprime les lignes visibles de la plage utile PLU
G2.ShowAllData 'supprime le filtre
 
ActiveWorkbook.Save
 
MsgBox "Données traitées" 'message
 
End Sub

La partie suppression de doublons fonctionne bien, par contre je rencontre un problème sur la suppression a partir des critères, car faisant cette action sur Onglet G1 puis sur Onglet G2, si il ne trouve rien en G1, la macro se bloque.
De plus je dois adapter cette recherche suppression sur plus de 60 items.
Dois je faire pour chaque item, chaque onglet ce qui représente plus de 120X minimum ou existe t'il une action groupée plus simple.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
Set PL = G2.Range("A1").CurrentRegion 'définit la plage PL (onglet G2)
Set PLU = PL.Offset(1, 0).Resize(PL.Rows.Count - 1, PL.Columns.Count) 'définit la plage utile PLU (sans la première ligne de PL)
PL.AutoFilter Field:=3, Criteria1:="=*CON-NC*" 'filtre le cas colonne D
PLU.SpecialCells(xlCellTypeVisible).EntireRow.Delete 'supprime les lignes visibles de la plage utile PLU
G2.ShowAllData 'supprime le filtre

Merci a ceux qui accepteront de m'accompagner pour m'aider a adapter et surtout comprendre.

Bien a vous tous

[78chris]

Bonjour

Cela vaudrait peut-être la peine de tenter un traitement PowerQuery intégré à 365

Lister les codes à rejeter dans un tableau : ainsi par requête ils seront éliminés avant de déboulonner le reste.

[Muzzik]

Bonjour Chris

Merci de ton retour, j'ai déja des difficultés avec VBA, alors PowerQuery je ne connais pas du tout.

[78chris]

RE

Peux-tu joindre un fichier simplifié (10 lignes par onglet) mais avec les bonnes en-têtes de colonnes et types de données et un 3ème onglet avec une liste de quelques code à éliminer

Si tu ne peux joindre ici, passe par cjoint ou équivalent et envoie le lien en MP

[Muzzik]

Chris

Ci dessous un fichier light pour test, a ta dispo pour apprendre

test CFA PWRQUERY.xlsx

[78chris]

Bonjour

Ton fichier ne contient pas de liste de valeurs à supprimer

Un truc m'interpelle : tu dédoublonnes sur C et D mais en principe C et D doivent être liés à A et B et surtout en cas de prix différent tu en as gardé un aléatoirement

[Muzzik]

Bonjour Chris

Désolé un oubli de ma part, et surtout pas vérifier avant diffusion.

Voila chose faitetest CFA PWRQUERY.xlsx

pour le dédoublonnage oui je le fais sur les valeurs C & D, il en reste car dans ce fichier un produit nommés XXX-XXX= et XXX-XXX sont les memes mais souvent pas au même prix.
La valeur avec un = signifie produit de Spare ( sans élément additionnel comme cable/alimentation/carte) donc moins chère.

Je travail sur une refonte complète de mes macros sur cet épuration donc toutes les bonnes idées sont a prendre en compte.

[BENNASR]

bonjour à tous
je propose le schéma suivant : alimenter un dictionnaire / filtrer avec ce dico / supprimer lignes visibles
à tester :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub FiltreInverseListe()
Application.ScreenUpdating = False
Dim f1 As Worksheet
Dim f2 As Worksheet
Dim f3 As Worksheet
  Set f1 = Sheets("Glemea1")
   Set f2 = Sheets("Glemea2")
   Set f3 = Sheets("Liste a supprimer")
  Set d = CreateObject("scripting.dictionary")
  d.CompareMode = vbTextCompare
  For Each c In f3.Range("A1:A" & f3.[A65000].End(xlUp).Row)
    d(c) = c.Value
  Next c
 f1.Range("A1:F" & f1.Range("A" & Rows.Count).End(xlUp).Row).AutoFilter Field:=3, Criteria1:=d.keys, Operator:=xlFilterValues
 If f1.AutoFilter.Range.Columns(3).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then f1.Range("A2:F" & f1.Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).EntireRow.Delete
 If f1.FilterMode = True Then f1.ShowAllData
 f2.Range("A2:F" & f2.Range("A" & Rows.Count).End(xlUp).Row).AutoFilter Field:=3, Criteria1:=d.keys, Operator:=xlFilterValues
 If f2.AutoFilter.Range.Columns(3).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then f2.Range("A2:F" & f2.Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).EntireRow.Delete
 If f2.FilterMode = True Then f2.ShowAllData
Application.ScreenUpdating = True
End Sub

[Muzzik]

Bonjour Benasr

Je te remercie d'avoir pris du temps sur ma demande, je viens de tester mais rien ne se passe la macro s'exécute mais sans résultat,
J'ai modifié f2.Range("A2:F" & par A1:F
Pour le reste j'ai bien compris que l'on utilisait la liste a supprimer pour en faire un "Dictionnaire" mais sans résultat sur mon test.

Mais comme je suis un novice j'ai du zapper quelque chose

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
f1.Range("A1:F" & f1.Range("A" & Rows.Count).End(xlUp).Row).AutoFilter Field:=3, Criteria1:=d.keys, Operator:=xlFilterValues
 If f1.AutoFilter.Range.Columns(3).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then f1.Range("A2:F" & f1.Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).EntireRow.Delete
 If f1.FilterMode = True Then f1.ShowAllData
 f2.Range("A2:F" & f2.Range("A" & Rows.Count).End(xlUp).Row).AutoFilter Field:=3, Criteria1:=d.keys, Operator:=xlFilterValues
 If f2.AutoFilter.Range.Columns(3).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then f2.Range("A2:F" & f2.Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).EntireRow.Delete
 If f2.FilterMode = True Then f2.ShowAllData

[BENNASR]

1 - Rien à modifier
2- je crois que simplement parce qu'il n'y a pas d'article qui existe en feuille3 (liste à supprimer) et en même temps dans les deux onglets (colonne C)
pour tester le code ajoutez dans la liste un code article fictif et en même et avec le même code ajoutez des lignes dans les deux feuilles et exécutez le code

si non donnez un un code article qui prouve le dysfonctionnement du code

[Muzzik]

Re

Alors oui ton code fonctionne a merveille mais sur une référence exact et complète.
j'ai fait un test avec CML-CE-10N-3Y et la ligne se supprime nickel.

Je me suis sans doute mal exprimé mais la liste à supprimer c'est les références qui "commence par" ex : CON-SSP4P je dois supprimer les références d'un groupe complet qui "commence par"
j'ai essayé de regrouper au maximum les références en fonction de ce que j'aimerai encore un exemple dans mon très gros fichier je souhaite conserver les références qui commence par CON-SNT mais je souhaite supprimer les références qui commence par CON-SNTE & CON-SNTPL.

Pourrais tu m'expliquer car je ne connais pas la syntaxe pour modifier celui ci s'il te plait

[BENNASR]

je sais pas si j'ai compris
tester ça avec prudence sur une copie de ton fichier...je ne suis qu'un autodidacte

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Sub FiltreInverseListe()
Application.ScreenUpdating = False
Dim f1 As Worksheet
Dim f2 As Worksheet
Dim f3 As Worksheet
Dim T As Long
Dim lig As Long
  Set f1 = Sheets("Glemea1")
  Set f2 = Sheets("Glemea2")
  Set f3 = Sheets("Liste a supprimer")
  Set d = CreateObject("scripting.dictionary")
  d.CompareMode = vbTextCompare
  For Each c In f1.Range("C2:C" & f1.[C65000].End(xlUp).Row)
  For lig = 1 To f3.[A65000].End(xlUp).Row
  T = Len(f3.Cells(lig, "A"))
  If Left(c, T) = f3.Cells(lig, "A") Then d(c) = c
  lig = lig + 1
  Next lig
  Next c
 
 Set d2 = CreateObject("scripting.dictionary")
  d2.CompareMode = vbTextCompare
 
  For Each c In f2.Range("C2:C" & f2.[C65000].End(xlUp).Row)
  For lig = 1 To f3.[A65000].End(xlUp).Row
  T = Len(f3.Cells(lig, "A"))
  If Left(c, T) = f3.Cells(lig, "A") Then d2(c) = c
  lig = lig + 1
  Next lig
  Next c
 
   f3.Range("c2").Resize(d.Count) = Application.Transpose(d.keys)
 f1.Range("A1:F" & f1.Range("A" & Rows.Count).End(xlUp).Row).AutoFilter Field:=3, Criteria1:=d.keys, Operator:=xlFilterValues
 If f1.AutoFilter.Range.Columns(3).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then f1.Range("A2:F" & f1.Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).EntireRow.Delete
If f1.FilterMode = True Then f1.ShowAllData
f2.Select
f2.Activate
 f2.Range("A1:F" & f2.Range("A" & Rows.Count).End(xlUp).Row).AutoFilter Field:=3, Criteria1:=d2.keys, Operator:=xlFilterValues
 If f2.AutoFilter.Range.Columns(3).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then f2.Range("A2:F" & f2.Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).EntireRow.Delete
 If f2.FilterMode = True Then f2.ShowAllData
Set d = Nothing
Set f1 = Nothing
Set f2 = Nothing
Set f3 = Nothing
Application.ScreenUpdating = True
End Sub

[Muzzik]

Merci du temps que tu me consacres,

Celle ci fonctionne sur un fichier avec peu de référence (fichier test), des que je teste sur ma BD 1050000 lignes il couine

J'ai testé et j'ai plusieurs erreurs.

Erreur d'exécution 13
Incompatibilité de type

1 - il souhaite me copier dans l'onglet "Liste a supprimer" les références qu'il supprime de l'ongle Glemea1, sauf que dans mon fichier j'ai environ 500 000 lignes qui devraient dégagé.

[78chris]

Bonjour à tous

Une solution PowerQuery

Utiliser Données, Actualiser tout pour tester avec les 2 premiers onglets complétés

[Muzzik]

Bonsoir 78Chris

Merci pour ton travail que j'ai regardé et que j'essaye de comprendre, mais je suis perdu car je ne sais pas du tout comment fonctionne powerquery.

Je vais essayer de passer du temps sur des tutos pour essayer d'appréhender la solution

Je reviens vers toi des que possible

Bien a toi

[78chris]

RE

Teste déjà en collant tes données dans les 2 premiers onglets

Si cela fonctionne avec un temps correct sur ton volume, je détaillerai les requêtes

[Muzzik]

Alors j'ai collé mes données en G1 et G2 mais après lancement de la requete j'ai un message

Cette requete a fourni plus de données que la feuille peut en contenir.


Sur Glemea1 j'ai 1 000 000 de lignes et idem sur Glemea 2 avant les requetes.

J'ai teste en ne prenant qu'un seul onglet et j'ai le meme message.

J'ai besoin de ton regard affuté, stp

[78chris]

RE

Cela veut dire qu'une fois les doublons enlevés et les listes expurgées des codes de la liste des valeurs à supprimer, il subsiste plus de 1 million de lignes

En vérifiant j'ai vu qu'un seule des deux listes a été dédoublonnée (oubli de ma part)

Une variante ci-joint dédoublonnant le cumul et non chaque liste

Commence pas tester en ne laissant qu'une ligne de données dans le second onglet puis si c'est bon remplis le second et relance.

Si c'est trop gros il faudra éclater la synthèse en 2 onglets

[BENNASR]

bonjour

Celle ci fonctionne sur un fichier avec peu de référence (fichier test), des que je teste sur ma BD 1050000 lignes il couine
J'ai testé et j'ai plusieurs erreurs.
Erreur d'exécution 13
Incompatibilité de type
1 - il souhaite me copier dans l'onglet "Liste a supprimer" les références qu'il supprime de l'ongle Glemea1, sauf que dans mon fichier j'ai environ 500 000 lignes qui devraient dégagé.

Sans doute ce n'est pas la bonne solution pour une telle volumineuse base de données ... je modifie le code pour le cas ou un demandeur potentiel ne dispose pas de powerquery proposé par 78chris (bonjour au passage) et une base de donnée moins volumineuse

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Sub FiltreInverseListe()
Application.ScreenUpdating = False
Dim f1 As Worksheet
Dim f2 As Worksheet
Dim f3 As Worksheet
Dim T As Long
Dim lig As Long
  Set f1 = Sheets("Glemea1")
  Set f2 = Sheets("Glemea2")
  Set f3 = Sheets("Liste a supprimer")
  Set d = CreateObject("scripting.dictionary")
  d.CompareMode = vbTextCompare
  For Each c In f1.Range("C2:C" & f1.Range("C" & Rows.Count).End(xlUp).Row)
  For lig = 1 To f3.Range("A" & Rows.Count).End(xlUp).Row
  T = Len(f3.Cells(lig, "A"))
  If Left(c, T) = f3.Cells(lig, "A") Then d(c) = c
  lig = lig + 1
  Next lig
  Next c
  Set d2 = CreateObject("scripting.dictionary")
  d2.CompareMode = vbTextCompare
  For Each c In f2.Range("C2:C" & f2.[C65000].End(xlUp).Row)
  For lig = 1 To f3.Range("A" & Rows.Count).End(xlUp).Row
  T = Len(f3.Cells(lig, "A"))
  If Left(c, T) = f3.Cells(lig, "A") Then d2(c) = c
  lig = lig + 1
  Next lig
  Next c
 f1.Range("A1:F" & f1.Range("A" & Rows.Count).End(xlUp).Row).AutoFilter Field:=3, Criteria1:=d.keys, Operator:=xlFilterValues
 If f1.AutoFilter.Range.Columns(3).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then f1.Range("A2:F" & f1.Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).EntireRow.Delete
If f1.FilterMode = True Then f1.ShowAllData
f2.Select
f2.Activate
 f2.Range("A1:F" & f2.Range("A" & Rows.Count).End(xlUp).Row).AutoFilter Field:=3, Criteria1:=d2.keys, Operator:=xlFilterValues
 If f2.AutoFilter.Range.Columns(3).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then f2.Range("A2:F" & f2.Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).EntireRow.Delete
 If f2.FilterMode = True Then f2.ShowAllData
Set d = Nothing
Set f1 = Nothing
Set f2 = Nothing
Set f3 = Nothing
Application.ScreenUpdating = True
End Sub

[Muzzik]

Bonjour a tous

Merci Bennasr pour ta solution et désolé que nous ne trouvions pas de solution ensemble.

Pour Chris,

Les premiers retour apres test,

J'ai pris ton dernier fichier et j'ai testé mais je ne comprends pas
Je fais un test light avec Glemea1 (33 lignes) Glemea2 (30 lignes) avec des doublons et surtout un mix de références a supprimer et l'onglet Tout concatène 44 lignes.
Question faut il que les références de la liste a supprimer soit ex : CON-SSSNC ou un simple CON-SSS suffit pour supprimer, car j'ai un doute.
Après plusieurs essai je dirai oui mais j'ai un exemple la réf CON-NCFP est présente dans les éléments a supprimer mais apparait dans l'onglet Tout après traitement,
sans doute du au fait que je dois mal faire quelque chose,

le temps de traitement est super long il faut pour 60 lignes a analyser minimum 5 minutes pour ce connecter a la source de données ??