Discussion :

[lps02]

bonjour les maitres du vba

Ci dessous le code que j'ai créé avec un peu de mal pour faire une somme selon les types.
En outre, j'ai rentré la zone de K12à k 2000 par prudence car le nombre de ligne pour la colonne K peut changer.
Ce code fonctionne mais parait un peu lent;
y a t il moyen de le simplifier?

A vous lire

cordialement

lps02

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
Dim i As Long, LigFin As Long
Dim fct As String, fct1 As String, fct2 As String, fct3 As String, fct4 As String
 
LigFin = [AE65536].End(xlUp).Row
 
For i = 3 To LigFin
    fct = "=SUMPRODUCT($K$12:$K$2000*(($A$12:$A$2000)=" & Range("AE" & i).Address(False, True) & ")*(($G$12:$G$2000)=AF$2))"
    fct1 = "=SUMPRODUCT($K$12:$K$2000*(($A$12:$A$2000)=" & Range("AE" & i).Address(False, True) & ")*(($G$12:$G$2000)=AG$2))"
    fct2 = "=SUMPRODUCT($K$12:$K$2000*(($A$12:$A$2000)=" & Range("AE" & i).Address(False, True) & ")*(($G$12:$G$2000)=AH$2))"
    fct3 = "=SUMPRODUCT($K$12:$K$2000*(($A$12:$A$2000)=" & Range("AE" & i).Address(False, True) & ")*(($G$12:$G$2000)=AI$2))"
    fct4 = "=SUMPRODUCT($K$12:$K$2000*(($A$12:$A$2000)=" & Range("AE" & i).Address(False, True) & ")*(($G$12:$G$2000)=AJ$2))"
    Cells(i, 32) = Evaluate(fct)
    Cells(i, 33) = Evaluate(fct1)
    Cells(i, 34) = Evaluate(fct2)
    Cells(i, 35) = Evaluate(fct3)
    Cells(i, 36) = Evaluate(fct4)
   Range("AK" & i).Formula = "=" & Range("AF" & i).Address(False, True) & "+" & Range("AG" & i).Address(False, True) & "+" & Range("AH" & i).Address(False, True) & "+" & Range("AI" & i).Address(False, True) & "+" & Range("AJ" & i).Address(False, True) & ""
 
Next i
 
End Sub

[Daranc]

certes amèliorer le code mais si tu nous disais plutôt ce qu'il doit faire et sur quoi il doit travailler.
le code sera peut être complètement différent. plus "tordu" pour être plus rapide


je te propose toujours ceci à toi de voir si ça accélère

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
Sub sub_macro()
 
Dim i As Long, LigFin As Long, j As Long
Dim fct As String, fct1 As String, fct2 As String, fct3 As String, fct4 As String
Dim pose()
LigFin = [AE65536].End(xlUp).Row
 j = 1
For i = 3 To LigFin
    fct = "=SUMPRODUCT($K$12:$K$2000*(($A$12:$A$2000)=" & Range("AE" & i).Address(False, True) & ")*(($G$12:$G$2000)=AF$2))"
    fct1 = "=SUMPRODUCT($K$12:$K$2000*(($A$12:$A$2000)=" & Range("AE" & i).Address(False, True) & ")*(($G$12:$G$2000)=AG$2))"
    fct2 = "=SUMPRODUCT($K$12:$K$2000*(($A$12:$A$2000)=" & Range("AE" & i).Address(False, True) & ")*(($G$12:$G$2000)=AH$2))"
    fct3 = "=SUMPRODUCT($K$12:$K$2000*(($A$12:$A$2000)=" & Range("AE" & i).Address(False, True) & ")*(($G$12:$G$2000)=AI$2))"
    fct4 = "=SUMPRODUCT($K$12:$K$2000*(($A$12:$A$2000)=" & Range("AE" & i).Address(False, True) & ")*(($G$12:$G$2000)=AJ$2))"
   ' Cells(i, 32) = Evaluate(fct)
    'Cells(i, 33) = Evaluate(fct1)
    'Cells(i, 34) = Evaluate(fct2)
    'Cells(i, 35) = Evaluate(fct3)
    'Cells(i, 36) = Evaluate(fct4)
  ' Range("AK" & i).Formula = "=" & Range("AF" & i).Address(False, True) & "+" & Range("AG" & i).Address(False, True) & "+" & Range("AH" & i).Address(False, True) & "+" & Range("AI" & i).Address(False, True) & "+" & Range("AJ" & i).Address(False, True) & ""
 ReDim Preserve pose(1 To 6, 1 To j)
 pose(1, j) = Evaluate(fct)
  pose(2, j) = Evaluate(fct1)
  pose(3, j) = Evaluate(fct2)
  pose(4, j) = Evaluate(fct3)
  pose(5, j) = Evaluate(fct4)
  For t = 1 To 5
  pose(6, j) = pose(6, j) + pose(t, j)
  Next t
  j = j + 1
Next i
 Range("ae3:aj" & j + 1).Value = Application.WorksheetFunction.Transpose(pose)
End Sub

[lps02]

Bonjour Daranc

Merci pour ta réponse. C'est en effet un peu plus rapide.

j'ai toutefois une procedure plus générale qui "rame".
Notamment, la plage de cellules K12 à 2000, varie en nombre de ligne mais pas en nombre de colonnes.

Ce sont des lignes que j'extrait d'ue base de données apres filtre des données.
Je retravaille mon code et vous recontacterai.
Merci encore pour votre aide


Bien cordialement.

[Daranc]

je ne sais pas il me semble qu'il t a un truc à voir du coté de ce style

Code :

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

t = Cells(1, 1).SpecialCells(xlLastCell).Row