Discussion :

[ayudame_joel]

Bonjour à tous, J'ai un soucis avec la fonction transposé. Le problème est que quand je fais la transposée d'une matrice de 132000 lignes, il me retourne une la transposée mais pour seulement 1730 lignes au lieu de me retourner la transposée de ma matrice complète. J'ai mis en PJ une photo du problème. je mets aussi mon code.

Code vba :

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
 
Sub joel()
 
Dim T_colA, T_colB, T_colC, T_colD, N As Double, A As Worksheet, b
Dim Tableau
Dim Dico As Object, Cptr As Double, Nbre_uniq As Double, ref
Dim T_uniq, T_outGrele, T_outTemp, T_outARC, filtre As Integer
Dim Cptr_u As Double, Nbre_lig As Double, Nbre As Double, SommeGrele As Double, SommeTemp As Double, SommeARC As Double
Dim Start As Single
'Calcul du temps d'exécution de ma macro avec Start = Timer en début de macro, l'affichage se fera avec Msgbox en fin de macro
Start = Timer
 
'N = 14
Set A = Worksheets("Test résultats")
N = A.Cells(Rows.Count, 1).End(xlUp).Row
ReDim T_colA(N), T_colB(N), T_colC(N)
With A
'     Derlig = .Columns(1).Find("*", , , , , xlPrevious).Row
 
     'variables tableaux source
'     Tableau = .Range("A2:A" & N).Value
     T_colA = Application.WorksheetFunction.Transpose(.Range("A2:A" & N).Value)
     T_colB = Application.Transpose(.Range("B2:B" & N).Value)
     T_colC = Application.Transpose(.Range("C2:C" & N).Value)
     T_colD = Application.Transpose(.Range("D2:D" & N).Value)
     'liste des uniques
     Set Dico = CreateObject("scripting.dictionary")
     For Cptr = 1 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_outGrele(0 To Nbre_uniq - 1)
       ReDim T_outTemp(0 To Nbre_uniq - 1)
       ReDim T_outARC(0 To Nbre_uniq - 1)
 
       For Cptr_u = 0 To UBound(T_uniq)
          'nombre de lignes ayant la valeur de T_uniq
'          filtre = UBound(Filter(T_colA, T_uniq(Cptr_u), True))
          Nbre_lig = UBound(Filter(T_colA, T_uniq(Cptr_u), True)) + 1
          SommeGrele = 0
          SommeTemp = 0
          SommeARC = 0
          Nbre = 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
                    SommeGrele = SommeGrele + T_colB(Cptr)
                    SommeTemp = SommeTemp + T_colC(Cptr)
                    SommeARC = SommeARC + T_colD(Cptr)
                    Nbre = Nbre + 1
               End If
          Next Cptr
          T_outGrele(Cptr_u) = SommeGrele
          T_outTemp(Cptr_u) = SommeTemp
          T_outARC(Cptr_u) = SommeARC
       Next Cptr_u
End With
 
With A
     .Range("F2").Resize(Nbre_uniq, 1) = Application.Transpose(T_uniq)
     .Range("G2").Resize(Nbre_uniq, 1) = Application.Transpose(T_outGrele)
     .Range("H2").Resize(Nbre_uniq, 1) = Application.Transpose(T_outTemp)
     .Range("I2").Resize(Nbre_uniq, 1) = Application.Transpose(T_outARC)
     .Activate
End With
Application.ScreenUpdating = True
MsgBox "Durée du traitement: " & Timer - Start & " secondes"
End Sub

Merci d'avance à ceux qui voudront m'aider.