Discussion :

[le_dabbabi]

Bonjour;


J'ai un tableau Excel qui avoisine les 50 000 lignes, ce tableau contient des lignes en double dans chaque ligne on trouve un code et une quantité mon objectif c'est de faire la somme des quantités de chaque code et les mettre dans un autre tableau.
Ma macro fonctionne très bien mon soucié qu'elle prend beaucoup de temps ( elle dépasse les 45 min des fois )

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
Application.ScreenUpdating = False 'juste pour arrêter affichage écran et améliorer le temps d'exécution du macro 
'***********************************Effacer Enciennes Données
With Sheets("feuil3")
.Cells.ClearContents
End With
Dim T
Set dico = CreateObject("Scripting.dictionary")
With Sheets("Quantité produite")
        dernl = .Range("D" & .Rows.Count).End(xlUp).Row
                For j = 1 To dernl
                 x = .Range("A" & j) & ";" & .Range("B" & j) & ";" & .Range("C" & j) & ";" & .Range("D" & j) & ";" & .Range("E" & j)
                 dico(x) = .Range("A" & j) & ";" & .Range("B" & j) & ";" & .Range("C" & j) & ";" & .Range("D" & j) & ";" & .Range("E" & j)
                Next j
Cle = dico.Keys
L = 1
TABLO = .Range("A1", "F" & .Range("F" & .Rows.Count).End(xlUp).Row)
End With
 
With Sheets("feuil3")
    For i = 0 To dico.Count - 1
        T = Split(dico(Cle(i)), ";")
        .Cells(L, 1).Value = Cle(i)
        .Cells(L, 1).Value = T(0)
        .Cells(L, 2).Value = T(1)
        .Cells(L, 3).Value = T(2)
        .Cells(L, 4).Value = T(3)
        .Cells(L, 5).Value = T(4)
        L = L + 1
    Next
dernligne = .Range("D" & .Rows.Count).End(xlUp).Row
 
Dim somme As Variant
For j = 1 To dernligne
   For i = LBound(TABLO, 1) To UBound(TABLO, 1)
             If .Cells(j, 5) = TABLO(i, 5) And .Cells(j, 4) = TABLO(i, 4) Then
                 somme = somme + TABLO(i, 6)
                .Cells(j, 6) = somme
              End If
      Next i
     somme = 0
 Next j
End With

Je compte sur votre aide , Merci d'avance

[BENNASR]

bonjour

J'ai un tableau Excel qui avoisine les 50 000 lignes, ce tableau contient des lignes en double dans chaque ligne on trouve un code et une quantité mon objectif c'est de faire la somme des quantités de chaque code et les mettre dans un autre tableau.

n'est pas claire au moins pour moi mais si tu insère un TCD çe ne résolu pas ton problème??

[le_dabbabi]

bonjour

n'est pas claire au moins pour moi mais si tu insère un TCD çe ne résolu pas ton problème??

Merci pour votre réponse j’espère que ce poste va vous faire un refresh mémoire
https://www.developpez.net/forums/d1...omme-cellules/

[BENNASR]

La vérité je souviens que de ce jolie drapeau avec l'étoile et le croissant que j'aime beaucoup .... oublier est le fait du temps et de la vieillesse
je vais voir qu'est ce qu'on peut améliorer dans ce code pour une base de 50 milles lignes sur Excel !!!
ne fermez pas les yeux devant le risque de gérer cette gigantesque base des données avec Excel
a+

[BENNASR]

la solution à tout le bricolage que j'ai fais lors de mon ancienne intervention se trouve dans le SUPER TUTORIEL du Grand MONSIEUR boisgontierjacques

http://boisgontierjacques.free.fr/pa....htm#TotalCout

à remplacer la totalité du code par :

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 testbildic()
Application.ScreenUpdating = False
Dim f As Worksheet
Dim f2 As Worksheet
Set f = Sheets("feuil1")
Set f2 = Sheets("feuil2")
f2.Cells.ClearContents
 f2.Cells(1, 1).Resize(1, 6) = Array(f.Cells(1, 1), f.Cells(1, 2), f.Cells(1, 3), f.Cells(1, 4), f.Cells(1, 5), f.Cells(1, 6))
  Set d = CreateObject("Scripting.Dictionary")
  TblBD = f.Range("A2:F" & f.Range("A" & Rows.Count).End(xlUp).Row)
  For i = 1 To UBound(TblBD)
    clé = TblBD(i, 1)  & "|" &  TblBD(i, 2)  &  "|"  &  TblBD(i, 3)  & "|" & TblBD(i, 4)  &  "|"  &  TblBD(i, 5)
    d(clé) = d(clé) + TblBD(i, 6)
  Next i
  f2.Range("A2").Resize(d.Count) = Application.Transpose(d.keys)
  f2.Range("f2").Resize(d.Count) = Application.Transpose(d.items)
  Application.DisplayAlerts = False
  f2.Range("A2").Resize(d.Count).TextToColumns Other:=1, OtherChar:="|"
Application.ScreenUpdating = True
f2.Select
End Sub

A tester et dire si ça arrange définitivement ton problème de temps d'exécution

[le_dabbabi]

ça fonctionne très bien Merci