Discussion :

[QuestVba]

Bonjour à tous,

Je dois récupérer des une DB de 200.000 lignes les données selon certains critères. Pour le moment j'utilise ce code pour récupérer le nombre de cas selon les trois critères :

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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
Sub FilTreElabore()
 
     Dim shTable:     Set shTable = Sheets("ruwe data")
     Dim shFilters: Set shFilters = Sheets("Filters")
 
     With shTable
          Dim LastRow: LastRow = .Range("A1").End(xlDown).Row
          Dim LastCol: LastCol = .Range("A1").End(xlToRight).Column
 
          'set columns
          Dim col, colAction, colFile, colAgt, colVerif, colWarning
          Dim colSubmit, colDone, colDone2
          For col = 1 To LastCol
                Select Case .Cells(1, col)
                     Case "Maand": colMois = col
                     Case "teller": colCompteur = col
                     Case "Bureau": colBur = col
                     Case "Agent": colAgt = col
                     Case "Dossiernummer": colDossNum = col
                     Case "Type": colType = col
                     Case "Dubbele verificatie": colDubVer = col
                     Case "Classificatie": colClass = col
                     Case "Start datum": colStDat = col
                     Case "Eind datum": colFinDat = col
                     Case "Status": colstatus = col
                     Case "Agent afhandeling (status)": colAgTrait = col
                     Case "Datum afhandeling (status)": colDatTrait = col
                     Case "doorlooptijd DB/verif": colTpsTrait = col
                     Case "doorlooptijd verificator": colTpsVerif = col
                     Case "to do verif": colAVer = col
                     Case "to do dossier": colDossAF = col
                     Case "Team": colTeam = col
 
 
                End Select
          Next
 
     End With
 
     'advanced filters
     Dim R
     Sheets("Filters").Activate
     'Vider la table de réception et filtre
     Range("2:6").Clear
     Range("A11:N" & Range("A10").End(xlDown).Row).Clear
 
     With shFilters
          R = 2
          sDone = "Notificaties"
          If sDone = "Notificaties" Then 'only "Soumis"
                .Cells(R, colAgt) = "Agent"
                .Cells(R, colType) = "Notificaties"
                .Cells(R, colstatus) = "Handled"
 
          End If
     End With
 
     With shTable
          R = shFilters.Range("A1").CurrentRegion.Rows.Count
          .Range(.Cells(1, 1), .Cells(LastRow, LastCol)).AdvancedFilter _
                xlFilterCopy, _
                shFilters.Range("A1:N" & R), _
                shFilters.Range("A10:N10"), _
                True
     End With
 
 
 
LastRowFilt = shFilters.Range("A10").End(xlDown).Row - 10
MsgBox LastRowFilt
End Sub

Mais comme je dois le faire pour 300 agents, cela risque de durer. N'est-il pas possible d'avoir le résultat sans passer par toutes les étapes. Je pensais que le code suivant pourrait aider mais je n'arrive pas à le comprendre intégralement et donc pour l'adapter au besoin, c'est compliqué.

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
Option Explicit
Private MODULE
' Module contenant les procédures utilisées dans le classeur illustrant le tutoriel Filtres avancés d'excel
Function ExportByFilter(znData As Range, znCriteria As Range, Optional znExport As Range) As Long
 ' Author : Philippe Tulliez http://philippe.tulliez.be
 ' Date : 01/11/2012
 ' Version : 1.0
 ' Procédure d'exportation basée sur le filtre élaboré
 ' Valeur renvoyée : Nombre d'enregistrements exporté
 ' znData     ' Table de données
 ' znCriteria ' Zone des critères
 ' [znExport]   ' Zone d'exportation (si vide Exporte tout, en créant une feuille)
 If znExport Is Nothing Then ' Création de la feuille d'export et coloration en rouge
  Worksheets.Add before:=Sheets(1)
  With Worksheets(1): ActiveCell = .Range("A1"): .Tab.Color = vbRed: End With
  Set znExport = ActiveCell
 End If
 znData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=znCriteria, CopyToRange:=znExport
 ExportByFilter = znExport.CurrentRegion.Rows.Count - 1
End Function
Public Sub ContrlFilterSelection()
 Application.ScreenUpdating = False
 Dim znSelection As Range
 Dim argData As Range, argCriteria As Range, argExport As Range
 Dim row As Byte ' N° de ligne
 Range("pnClearCriteria").Clear
 Set znSelection = Range("dbZnSelection") ' Zone sélection feuille [ControlFilters]
 Set argData = Range("dbZnDataList3") ' Table de données feuille [DataList3]
 Debug.Print znSelection.Address
 row = Range("pSelectionChoice") ' N° sélection dans la liste
 With Application.WorksheetFunction
  ' Zone Critères
  If Len(.Index(znSelection, row, 1)) Then Set argCriteria = Range(.Index(znSelection, row, 1))
  ' Zone Export
  If Len(.Index(znSelection, row, 2)) Then Set argExport = Range(.Index(znSelection, row, 2))
 End With
 Application.ScreenUpdating = True
 MsgBox "Nombre filtré " & ExportByFilter(argData, argCriteria, argExport)
End Sub
Function Formula(rng As Range) As String
 ' Fonction qui renvoie la formule de la cellule se trouvant en rng
 Formula = rng.FormulaLocal
End Function

Une bonne âme pourrait me venir en aide ?

NB : je dois évidemment récupérer d'autres données avec d'autres critères. Si vous avez une solution pour faire cela en moins de temps qu'il n'en faut, je suis preneur.

[Philippe Tulliez]

Bonjour,
Je pourrais t'aider, je pense mais j'aimerais pour m'éviter de relire tout ton code que tu dises quels sont les critères et si tout doit se retrouver dans une seule exportation ou si l'exportation doit par exemple être exporté sur 300 feuilles (300 agents) avec le même type de critères pour ceux ci.

[QuestVba]

Bonjour,

Merci pour ce début de réaction très rapide. Je dois faire cette exportation sur une seule et même feuille.

Mes 3 premiers critères sont en fonction de l'agent, des notifications (type de tâches) et des Handled (cas traités).

Code :

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

1
2
3
                .Cells(R, colAgt) = "Agent"
                .Cells(R, colType) = "Notificaties"
                .Cells(R, colstatus) = "Handled"

Donc j'aurais en
colonne A tous les agents,
colonne B un 1er résultat,
colonne C un autre résultat (autres critères),
...

Je mets en photo un exemple de la table de résultats






Sans compter que je dois fournir un autre résultat qui en découlera sur cette base

[boisgontierjacques]

Bonsoir,

Le filtre élaboré n'est pas très rapide.

Dans l'exemple joint:

1- On extrait de la BD avec le filtre élaboré tous les éléments qui correspondent à 2 critères
2- On ventile le résultat de l'extraction dans plusieurs onglets avec une boucle (+ rapide que le filtre élaboré)

1 sec pour ventiler 64.000 lignes sur 8 onglets

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
 
Sub Extrait()
  Dim i&, Premier&, Ncol&, ColCritère&, n&
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Sheets.Add Before:=Sheets(1)
  Set f = Sheets(1)
  Sheets("bd").Range("A1:D64000").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("bd").Range("G1:H2"), CopyToRange:=Sheets(1).Range("A1"), Unique:=False
  Ncol = 4                ' Adapter ou Ncol=f.[A1].CurrentRegion.Columns.Count
  ColCritère = 2          ' adapter
  Derlig = f.[a65000].End(xlUp).Row
  Set Rng = f.Cells(2, 1).Resize(Derlig, Ncol)
  Rng.Sort key1:=f.Cells(2, ColCritère), Header:=xlNo
  TblCrit = f.Cells(2, ColCritère).Resize(Derlig - 1)
  i = 1: Premier = 1
  n = UBound(TblCrit)
  Do While i <= n
    code = TblCrit(i, 1)
    Do While TblCrit(i, 1) = code
      i = i + 1: If i > n Then Exit Do
    Loop
    On Error Resume Next: Sheets(code).Delete: On Error GoTo 0
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = code
    f.Cells(1 + Premier, 1).Resize(i - Premier, Ncol).Copy [A2]
    f.Cells(1, 1).Resize(, Ncol).Copy [A1]
    Premier = i
  Loop
  Sheets(1).Delete
End Sub

Boisgontier

[QuestVba]

Bonsoir,

Merci pour cette piste. Je vais tester (dès que je suis de retour au travail).

Pour résumer autrement : En fait, je récupère ce fichier qui doit permettre de retrouver les données dans une DB de 200.000 lignes et 25 colonnes. Celui qui avait fait le 1er résultat est parti sur des SOMME.SI.ENS (image 1) et des RECHERCHEV (image 2). Mais cela prend une plombe et l'ordi rame tellement que j'ai l'impression qu'il va brûler; le ventilo s'affole comme un dingue.

C'est ainsi que j'ai pensé au filtre élaboré car c'est assez rapide mais je ne sais pas comment cela se comporte sur 300 agents et une 20aine de données à extraire avec différents filtres; et c'est aussi pour cela que j'ai pensé à Philippe et à son fichier mais j'ai pas tout compris; mais je voyais comme une sorte de raccourci. Donc, je suis preneur pour accélérer tout ce traitement. Si d'autres pistes sont envisageables, je suis preneur.

[Philippe Tulliez]

Bonsoir Jacques,

Le filtre élaboré n'est pas très rapide.

Je ne partage pas ton avis
Il est probable que dans certain cas le traitement en mémoire de tableau est plus rapide que l'élaboration du traitement par plusieurs filtres élaborés bien qu'il serait intéressant de faire un "benchmark" sur le sujet, je crois que dans bien des cas le code est plus simple à mettre en place, plus simple à modifier les paramètres directement sur une plage d'excel que de modifier le code en VBA.
Est-ce que quelques secondes ou minutes d'exécution plus rapide est plus importante que la simplicité d'un code qui ne demanderait plus de modification de code est à mettre en balance. C'est une question à se poser.
J'ai fait des tests avec la méthode AdvancedFilter qui exporte en moins d'une seconde des centaines de lignes sur une liste de données de centaines de milliers de lignes.
Je crois que les développeurs d'excel font également ce travail en mémoire.
Est-ce que la méthode Sort d'excel est plus rapide que redévelopper un tri mémoire ?
Moi, je suis partisan d'utiliser les méthodes natives d'excel avant de développer des boucles avec des tests à redévelopper chaque fois.
Mais je suis ouvert et prêt à en discuter.