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.

[boisgontierjacques]

Bonjour,

Avec une BD de 64.000 lignes , on obtient 20s avec le filtre et 0,7 sec avec une boucle.

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
 
Sub Extrait()
  t = Timer()
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Set f = Sheets(1)
  Ncol = 3           ' 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)
  TblCrit = f.Cells(2, ColCritère).Resize(Derlig - 1)
  i = 1: Premier = 1
  Do While i <= UBound(TblCrit)
    code = TblCrit(i, 1)
    Do While TblCrit(i, 1) = code
        i = i + 1: If i > UBound(TblCrit) 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
  MsgBox Timer() - t
End Sub

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
 
Sub ExtraitFiltre()
  t = Timer()
  Set f = Sheets("BD")
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  '--- Liste des services
  f.[A1:C65000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=f.[G1], Unique:=True
  For Each c In f.Range("G2:G" & f.[G65000].End(xlUp).Row) ' pour chaque code
    f.[G2] = c.Value
    On Error Resume Next
    Sheets(c.Value).Delete
    On Error GoTo 0
    Sheets.Add After:=Sheets(Sheets.Count) ' création
    ActiveSheet.Name = c.Value
    '-- extraction
    f.[A1:C65000].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=f.[G1:G2], CopyToRange:=[A1]
  Next c
  MsgBox Timer() - t
End Sub

Boisgontier

[Invité]

Bonjour,
Je suis dubitatif!
Difficile de mettre en compétition deux raisonnement! Qui de toutes les façons font appel à Vba.

Le traitement en mémoire est inévitablement plus rapide, et le filtre élaboré travail en mémoire également et la fonction est écrit en assembleur.difficile de faire mieux sauf en Sql.

Le raisonnement lui peut être optimiser très certainement!

[boisgontierjacques]

>Je suis dubitatif!

Les tests ne sont pas dubitatifs!

>Le traitement en mémoire est inévitablement plus rapide,

Il ne s'agit pas d'un traitement en mémoire mais d'un tri dans le tableur.
Le programme BDextraitCompare ci joint donne un rapport de 1 à 10 pour une BD de 5000 lignes (0,2 s contre 2 s)

>difficile de faire mieux sauf en Sql.

Extraction de 16.000 lignes d'une BD 65.000 lignes en SQL (2 sec) contre 0,4 sec avec le filtre élaboré.

Code :

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

1
2
3
4
5
6
Sub Filtre()
    t = Timer()
    Range("A1:E65000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        Range("H1:H2"), CopyToRange:=Range("L1"), Unique:=False        
    MsgBox Timer() - t
End Sub

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
Sub ADOSQL()
  t = Timer()
  'Microsoft ActiveX DataObject doit être coché
  repertoire = ThisWorkbook.Path & "\"
  nf = ThisWorkbook.Name
  Set cnn = New ADODB.Connection
  cnn.Open "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=" & repertoire & nf
  Set rs = cnn.Execute("SELECT * FROM [BD$A1:D65000] where code1='D'")
  [L2].CopyFromRecordset rs
  rs.Close
  cnn.Close
  Set rs = Nothing
  Set cnn = Nothing
  MsgBox Timer() - t
End Sub

Boisgontier

[QuestVba]

Bonsoir,

Bon ben j'ai essayé mais c'est pas génial comme avancement. Je suis sur ce code qui appelle une fonction (à chaque agent différent)

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
Sub CreationWorkTable()
Debug.Print Time
 
'Nombre de notifications
Sheets("WorkTable").Cells(1, 7).Value = "Notificaties"
 
'prendre agent
Dim Lig As Long
Dim x As Integer
Lig = Sheets("WorkTable").Range("C1").End(xlDown).Row
 
    For x = 2 To Lig
        cac = FiltreNotification(Sheets("WorkTable").Cells(x, 3).Value)
    Sheets("WorkTable").Cells(x, 7).Value = cac
    Next x
 
Debug.Print Time
 
End Sub

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
72
73
74
75
76
77
78
Function FiltreNotification(Agt)
 
     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
 
 
          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
                Cells(R, colAgt) = Agt
                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
 
 
If shFilters.Range("A11").End(xlDown).Value = "" Then
LastRowFilt = 0
Else
LastRowFilt = shFilters.Range("A10").End(xlDown).Row - 10
End If
 
 
'MsgBox LastRowFilt
    FiltreNotification = LastRowFilt
Sheets("WorkTable").Activate
End Function

J'ai en tout 584 agents et mon code prend 01'07''. Et comme je dois avoir 16 résultats avec différents critères, je suis parti pour 18'. C'est beaucoup trop long à mon goût, mais mes connaissances sont à cette hauteur donc, pas bien efficaces :

@ Philippe Tulliez : si tu peux m'expliquer ton code et s'il peut accélérer les choses ?

@ boisgontierjacques : je n'arrive à rien avec ton code. Certainement pas tout compris.

Un grand merci pour d'autres solutions extrarapides

[illight]

Bonjour

Alors déjà, j'ai du mal à comprendre ce que tu cherches par rapport à tes critères utilisés dans ton filtre avancé.

Pour ton information, j'ai, de mon côté, un fichier Excel avec à peu près 100000 lignes, que je dois trier en fonction de certaines informations. J'utilise le filtre avancé, qui me permet par la suite de créer des onglets en fonction de ce critères.
Sur un fichier de cette taille, où derrière j'ai 20 onglets qui se créent, le traitement prend 15 secondes, sachant que je n'ai pas de formules qui pointent sur les données résultats.

Ça, c'est juste pour ton info

Par rapport au 2e onglet que tu montres, y a-t-il des formules qui pointent sur les résultats des données triées ? Car si c'est le cas, il ne faut pas oublier de désactiver, temporairement, les calculs automatiques, de façon à ne pas ralentir ton traitement.

Par contre, je reviens à ma première question : je comprend pas le filtre que tu veux mettre en place. Par contre, ce que je pense est que le filtre avancé devrait être la meilleure solution pour toi.

Même en lisant plusieurs fois ton code, je comprend pas où sont tes critères de recherches, et où vont les résultats

[QuestVba]

Bonjour illight et tous les autres pour l'intérêt porté.

Bon on va essayer de prendre le temps de tout expliquer; tout le monde y gagnera. A force de m'énerver sur ce bête truc, je sais plus ce que je dis. Merci de me le rappeler.

Donc, j'ai des données en vrac qui représentent tout ce que les agents ont fait sur un mois. Voici comment je les reçois. C'est tout mélangé évidemment.



Le but est que je puisse fournir à chaque chef de service une feuille de rapport dans laquelle il sélectionne l'agent (en D2) pour voir ses indicateurs de prestation. Il ne pourra pas voir les données des autres bureaux ! Du style:



Je pensais donc fournir à chaque chef de service une feuille de données brutes (moins brute que celle du départ) où les données seraient en dur et où on irait les chercher avec un bête RECHERCHEV sur base de l'agent en D2.

Donc, j'ai commencé à construire les données résumées. J'ai ma liste d'agents (+ de 500) et je complète la première colonne de données qui sont les 'Notifications' (nombre reçues pour le mois). Cela se fait sur 3 critères : Agent + Notifications + Handled. D'où le code suivant via un filtre élaboré.

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
 
Sub CreationWorkTable()
Debug.Print Time
 
'Nombre de notifications ********************************************
Sheets("WorkTable").Cells(1, 7).Value = "Notificaties"
 
'Boucle sur tous les agents
Dim Lig As Long
Dim x As Integer
Lig = Sheets("WorkTable").Range("C1").End(xlDown).Row
 
'Vider tous les filtres et la table de réception des données
Sheets("Filters").Activate
Range("2:8").Clear
Range("A11:N" & Range("A10").End(xlDown).Row).Clear
'Placer les filtres communs
Sheets("Filters").Cells(2, 6) = "Notificaties"
Sheets("Filters").Cells(2, 11) = "Handled"
 
Dim LastRow: LastRow = Sheets("ruwe data").Range("A1").End(xlDown).Row
Dim LastCol: LastCol = Sheets("ruwe data").Range("A1").End(xlToRight).Column
 
    For x = 2 To Lig
 
        'Prendre les données de l'agent et les placer dans le filtre
        Sheets("Filters").Cells(2, 4) = Sheets("WorkTable").Cells(x, 3).Value
 
        'Filtres avancés
        Sheets("ruwe data").Range("A1:N" & LastRow).AdvancedFilter _
            Action:=xlFilterCopy, _
            CriteriaRange:=Sheets("Filters").Range("A1:N2"), _
            CopyToRange:=Sheets("Filters").Range("A10:N10"), _
            Unique:=False
        'calculé le nbre de données
        If Sheets("Filters").Range("A11").Value = "" Then
            LastRowFilt = 0
        Else
            LastRowFilt = Sheets("Filters").Range("A10").End(xlDown).Row - 10
        End If
 
        Sheets("WorkTable").Cells(x, 7).Value = LastRowFilt
    Next x
 
Debug.Print Time
 
End Sub

Pour mes agents (584), cela met 58" aujourd'hui. C'est pas mal mais je dois faire la même chose pour d'autres critères : le nombre de tâches système, le nombre de tâches automatiques, ... Donc, le code devrait tourner pendant 15'-20'. Est-ce possible d'accélérer la procédure pour diminuer ce temps de travail.

[illight]

Je te remercie pour ces précisions, j'y vois beaucoup plus clair. Par contre, j'ai encore des questions (ouais je sais, je suis pénible avec mes questions ).

- la feuille de rapport que tu nous montres, elle a des formules je pense : elles pointent sur quoi ?
Si elle a pas de formules, c'est un rapport que tu crée manuellement ?

De mon avis, et uniquement du mien, je partirai sur une autre base. je vais essayer de t'expliquer le cheminement que je préconises :
- à partir de ton fichier brut, je créerai une feuille pour l'agent choisi au préalable (par un formulaire, liste déroulante ?), en utilisant la fonction de filtre avancé sur l'agent en question. Déjà, là, tu auras normalement moins de données. Un truc dans ce genre :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Macro2()
Dim FSource As Worksheet
Dim FCible As Worksheet
Dim FCaisse As Worksheet
Dim Nblignes As Long
Set FSource = Worksheets("ruwe data")
Set FCrit = Worksheets("Critere")
Nblignes = FSource.Range("D2").End(xldown).Row
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = FCrit.Cells(2, 2).Value
    Set FCrit = Worksheets(FCrit.Cells(2, 2).Value)
    FSource.Select
    FSource.Range("A1:" & Split(FSource.Range("A1").End(xlToRight).Address, "$")(1) & Nblignes).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=FCrit.Range("A1:A2"), CopyToRange:=FCrit.Range("A1:" & Split(FSource.Range("A1").End(xlToRight).Address, "$")(1) & "1"), Unique:=False
End Sub

Dans ta feuille "critere", tu aurais ça :



En mettant évidemment le nom de ton agent

Déjà, et dans un premier temps, ça va te créer une feuille avec comme nom le nom de l'agent, et avec uniquement, dans cette feuille, les données de cet agent.


Après, pour moi, le filtre avancé permet de faire de filtrage, et non de compter des informations. Car, de ce que je comprend dans ton dernier post, tu utilises le filtre élaboré pour compter des lignes (qui correspond à tes 3 critères). Certes, ça va te filtrer les données les lignes en fonction de tes critères, mais ça ne va pas te les compter.

Or, pour faire des opérations de comptage comme tu le souhaites, pourquoi n'utilises-tu pas simplement des TCD ? Ça sera beaucoup plus simple et efficace : tu peux changer la source de ceux-ci par macro, et ensuite récupérer les informations dont tu as besoin pour remplir ton rapport.

Sur un fichier de 200000 lignes, je ne pense pas que cela soit envisageable, car ça prendrait trop de temps (à tester...), mais sur un fichier réduit par rapport à l'agent en lui-même, ça devrait être faisable ?? Tu as essayé ?

En espérant avoir fait avancé le Schimibilimilblik....

[QuestVba]

Re-,illight,

Par contre, j'ai encore des questions (ouais je sais, je suis pénible avec mes questions ).

Cela a l'avantage de faire le point !

- la feuille de rapport que tu nous montres, elle a des formules je pense : elles pointent sur quoi ?

Dans la feuille rapport, il y a au départ des SOMME.SI.ENS par millier à partir de la colonne K (vers la feuille de données brutes). Je veux les supprimer pour éviter le recalcul, ... Dans le tableau de l'agent il y a des RECHERCHEV.

Si elle a pas de formules, c'est un rapport que tu crée manuellement ?

Voir au dessus.

Déjà, et dans un premier temps, ça va te créer une feuille avec comme nom le nom de l'agent, et avec uniquement, dans cette feuille, les données de cet agent.

C'est une solution mais peut-on alors regrouper les agents d'un même bureau. Par code alors.

Après, pour moi, le filtre avancé permet de faire de filtrage, et non de compter des informations. Car, de ce que je comprend dans ton dernier post, tu utilises le filtre élaboré pour compter des lignes (qui correspond à tes 3 critères). Certes, ça va te filtrer les données les lignes en fonction de tes critères, mais ça ne va pas te les compter.

Effectivement, c'est un détournement pour compter.

Code :

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

Or, pour faire des opérations de comptage comme tu le souhaites, pourquoi n'utilises-tu pas simplement des TCD ?

Mais j'ai quelques soucis avec le TCD si je dois calculer le nombres de tâches de +de 25 jours.

En tout cas, un grand merci car cela avance.

[clementmarcotte]

Bonjour,

Ce n'est probablement pas LA réponse que tu veux, mais je suis en train de penser que tu pousse Excel à son extrême limite; et que tes problèmes de lenteur sont peut-être plus dûs à Windows qu'Excel; ou du moins une combinaison des deux.

Le problème majeur c'est qu'Excel a constamment besoin de tout son classeur en mémoire vive pour fonctionner. Et comme tu dis que tu as des formules par milliers, cela augmente dangereusement les besoins en mémoire vive. Je suppose que c'est la même chose pour le filtre. Et si, en plus, tu dois augmenter le nombre de feuilles pour t'en sortir, je crains que tu ne frappes le mur.

Cela vaudrait peut-être la peine que tu jettes un œil à la mémoire vive disponible quand tu exécutes ton classeur. Si tu vois qu'il t'en reste en masse, tu peux sans doute persévérer dans cette voie. Sinon, cela devient un problème de libérer de la mémoire vive en virant des services inutiles, comme la mise à jour automatique des programmes mis à jour une fois par année et tous les autres gugusses du genre.

Si cela coince encore, tu peux envisager un nouveau classeur qui va récupérer le minimum de données de ton classeur actuel, par ADO, ou des requêtes SQL.

Ou bien, ce qui serait MA préférence, (mais ce n'est vraiment pas du nouveau pour moi), serait d'utiliser VB.net pour interroger ta base par SQL et faire tes opérations à l'extérieur d'Excel. N'importe comment, ce serait plus vite que VBA. Tu peux même avoir Visual Studio Community (oublie Express) gratuitement. Tu pourrais même avec Community, mais pas avec Express, te faire un complément (add-in), oupss, Microsoft a "décidé" que ce serait maintenant une application, compilé(e) pour Excel.

Mais bon, inutile d'aller trop loin, trop vite...

[illight]

Salut,

C'est une solution mais peut-on alors regrouper les agents d'un même bureau. Par code alors.

Oui, bien évidemment, il suffit de rajouter une colonne B avec le même titre que tes données brutes, et faire la même macro (où j'avais glissé une erreur d'ailleurs ) :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Macro2()
Dim FSource As Worksheet
Dim FCible As Worksheet
Dim FCaisse As Worksheet
Dim Nblignes As Long
Set FSource = Worksheets("ruwe data")
Set FCrit = Worksheets("Critere")
Nblignes = FSource.Range("D2").End(xldown).Row
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = FCrit.Cells(2, 2).Value
    Set FCrit = Worksheets(FCrit.Cells(2, 2).Value)
    FSource.Select
    FSource.Range("A1:" & Split(FSource.Range("A1").End(xlToRight).Address, "$")(1) & Nblignes).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=FCrit.Range("A1:B2"), CopyToRange:=FSource.Range("A1:" & Split(FSource.Range("A1").End(xlToRight).Address, "$")(1) & "1"), Unique:=False
End Sub

Tu remarquera que j'ai changé cela :

Code :

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

CriteriaRange:=FCrit.Range("A1:B2")

Où je prend en compte la 2e colonne

Effectivement, c'est un détournement pour compter.

Code :

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

Or, pour faire des opérations de comptage comme tu le souhaites, pourquoi n'utilises-tu pas simplement des TCD ?

Mais j'ai quelques soucis avec le TCD si je dois calculer le nombres de tâches de +de 25 jours.

Je réitère, mais je pense que ça serait la meilleure solution pour ton besoin. Quel est ton souci en réalité ?
Je te propose d'effectuer un test : sur la feuille que tu construis à l'aide de la macro ci-dessus, tu créé un TCD, avec les champs, données, résultats que tu souhaites, et tu regardes ce que ça te donnes. Je pense qu'avc les filtrages propre aux TCD et autres, je suis convaincu que tu pourrais arriver à ce que tu souhaites mais là, je comprend pas ton souci par rapport aux dates

Rien ne t'empeche de faire plusieurs TCD

[QuestVba]

Ben c'est bien illight qui est sur la meilleure voie ! Félicitations.

NB: merci SCryptCypher pour une intervention en stoum ;-)