Variable tableau et somme.si

Version imprimable

Bonjour le forum,

J'ai une feuille d'environ 4000 lignes et 50 colonnes (Bom Sans Doublons). Pour faire simple, j'aurais besoin d'écrire la formule suivante en G2 de ma feuille sans doublons:

Code:

=SOMME.SI('BOM'!$A$2:$A$7446;'Bom Sans Doublons'!$A2;'BOM'!G$2:G$7446)

et de l'étirer sur 50 colonnes et 4000 lignes.

Comme vous pouvez l'imaginer, si je le fais manuellement, Excel plante sous la quantité de calculs.
J'ai essayé de passer par une variable tableau en adaptant le code que j'ai trouvé dans le tuto de Silkyroad (je fais l'essai sur une seule colonne).
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Set wksBomSansDoublons = Worksheets("Bom Sans Doublons") Set WsReBom = Worksheets("Bom") LigFinBomSansDoublons = wksBomSansDoublons.[A65536].End(xlUp).Row LigFinReBom = WsReBom.[A65536].End(xlUp).Row Set rngReBom = WsReBom.Range("A1:A" & LigFinReBom) Dim Montab As Variant, cmpt1 As Long, cmpt2 As Long With wksBomSansDoublons Montab = .Range("G2:G" & LigFinBomSansDoublons).Value For cmpt1 = LBound(Montab, 1) To UBound(Montab, 1) For cmpt2 = LBound(Montab, 2) To UBound(Montab, 2) Montab(cmpt1, cmpt2) = WorksheetFunction.SumIf(rngReBom, .Cells(cmpt1, 1), WsReBom.Range("G2:G" & LigFinReBom)) Next cmpt2 Next cmpt1 .Range("G2:G" & LigFinBomSansDoublons).Value = Montab End With
La macro ne plante pas, mais j'ai comparé les résultats que me donne ce code avec ceux que me donne la fonction SOMME.SI sur une colonne, et j'ai des différences pour 1700 lignes sur 4000, et je ne sais pas pourquoi...
Est-ce que vous auriez une idée, ou une manière plus simple de faire?

17/10/2011, 11h01
Daniel.C

Bonjour,

Mets :

Code:

Set rngReBom = WsReBom.Range("A2:A" & LigFinReBom)

au lieu de :

Code:

Set rngReBom = WsReBom.Range("A1:A" & LigFinReBom)

De plus, tu dois pouvoir simplifier le code (non testé, toutefois) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Set wksBomSansDoublons = Worksheets("Bom Sans Doublons")
Set WsReBom = Worksheets("Bom")
LigFinBomSansDoublons = wksBomSansDoublons.[A65536].End(xlUp).Row
LigFinReBom = WsReBom.[A65536].End(xlUp).Row
Set rngReBom = WsReBom.Range("A2:A" & LigFinReBom)
 
Dim Montab As Variant, cmpt1 As Long
With wksBomSansDoublons
    Montab = Application.Transpose(.Range("G2:G" & LigFinBomSansDoublons).Value)
    For cmpt1 = LBound(Montab) To UBound(Montab)
        Montab(cmpt1) = WorksheetFunction.SumIf(rngReBom, .Cells(cmpt1), WsReBom.Range("G2:G" & LigFinReBom))
    Next cmpt1
    .Range("G2:G" & LigFinBomSansDoublons).Value = Montab
End With

1 pièce(s) jointe(s)

Bonjour à tous

Une variante (avec création de la liste des uniqies) sous forme de maquette à adapter

le code:

Code:

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
Option Explicit
 
Sub sommer_si()
Dim Derlig As Integer
Dim T_colA, T_colC
Dim Dico As Object, Cptr As Integer, Nbre_uniq As Integer, ref
Dim T_uniq, T_out
Dim Cptr_u As Integer, Nbre_lig As Integer, Nbre As Integer, Somme As Double
 
With Sheets(1)
     Derlig = .Columns(1).Find("*", , , , , xlPrevious).Row
 
     'variables tableaux source
     T_colA = Application.Transpose(.Range("A2:A" & Derlig).Value)
     T_colC = Application.Transpose(.Range("C2:C" & Derlig).Value)
     'liste des uniques
     Set Dico = CreateObject("scripting.dictionary")
     For Cptr = 2 To UBound(T_colA)
          ref = T_colA(Cptr)
          If Not Dico.exists(ref) Then
               Dico.Add ref, 0
          End If
       Next
       Nbre_uniq = Dico.Count
       T_uniq = Dico.keys
       ReDim T_out(Nbre_uniq - 1)
 
       For Cptr_u = 0 To UBound(T_uniq)
          'nombre de lignes ayant la valeur de T_uniq
          Nbre_lig = UBound(Filter(T_colA, T_uniq(Cptr_u), True)) + 1
          Somme = 0
          For Cptr = 1 To UBound(T_colA)
               If Nbre = Nbre_lig Then Exit For 'boucle que sur le nombre de ligne de l'unique en cours
               If T_uniq(Cptr_u) = T_colA(Cptr) Then
                    Somme = Somme + T_colC(Cptr)
                    Nbre = Nbre + 1
               End If
          Next Cptr
          T_out(Cptr_u) = Somme
       Next Cptr_u
End With
 
With Sheets(2)
     .Range("A2").Resize(Nbre_uniq, 1) = Application.Transpose(T_uniq)
     .Range("B2").Resize(Nbre_uniq, 1) = Application.Transpose(T_out)
     .Activate
End With
 
End Sub

17/10/2011, 11h46
neiluj26

Bonjour à tous,

Merci pour vos réponses.
Bon, je ne suis pas encore à l'aise avec les variables tableaux, ni avec Transpose (évidemment...:mouarf:), mais j'ai testé tes suggestions Daniel.
La première ne change rien. J'ai toujours un écart sur sur 1700 lignes que je ne m'explique pas. A la ligne 8 par exemple, le code me donne un total de 182 alors que je devrais trouver 3... même en contrôlant visuellement, je ne vois pas.

La deuxième suggestion donne le même résultat (celui de la première ligne) sur toute les lignes. Je vais essayer de comprendre pour vois ce qui ne va pas.

Je vais également tâcher de tester la suggestion de Michel. :)
17/10/2011, 11h56
Daniel.C

Regarde l'aide sur la fonction SOMME.SI en cas de plages de longueurs inégales.
17/10/2011, 14h39
neiluj26

Argh, je ne sais pas lire non plus. J'avais mal lu ta suggestion. La macro fonctionne maintenant (et les plages sont bien de longueur égale).

Le code s'effectue maintenant en 12/13 minutes, ce qui n'est déjà pas si mal...
par contre, j'aimerais bien comprendre comment tu te sers de transpose.
17/10/2011, 15h41
Daniel.C

Transpose fonctionne comme la fonction Excel. Quand tu envoies une colonne dans un tableau comme tu l'as fait au début, tu récupères un tableau bi-dimensionnel (une dimension pour la ligne et une pour la colonne), d'où l'obligation de faire une double boucle. En utilisant Transpose, tu ne récupères qu'un tableau simple chaque entrée du tableau correspond à une cellule de la colonne.