cathodique
XLDnaute Barbatruc
Bonjour
,
Sur le site de Jacques Boisgontier (ce lien), j'ai récupéré un code de tri d'un array.
Sur le fichier joint, le tableau figurant sur la feuille1 est le tableau obtenu de mon fichier de réel.
Donc, sur ce fichier je parviens bien à obtenir le résultat escompté.
Par contre, sur mon véritable fichier qui est conséquent en données et confidentielles.
Je n'arrive pas à adapter le code de Jacques.
Cela fait, 2 jours que je tourne en rond. Mon code fonctionne bien, Les problèmes commencent au tri du tableau.
Merci de déceler mes erreurs dans code ci-dessous.
Avec mes remerciements anticipés.
NB: fichier joint modifié.
,Sur le site de Jacques Boisgontier (ce lien), j'ai récupéré un code de tri d'un array.
Sur le fichier joint, le tableau figurant sur la feuille1 est le tableau obtenu de mon fichier de réel.
Donc, sur ce fichier je parviens bien à obtenir le résultat escompté.
Par contre, sur mon véritable fichier qui est conséquent en données et confidentielles.
Je n'arrive pas à adapter le code de Jacques.
Cela fait, 2 jours que je tourne en rond. Mon code fonctionne bien, Les problèmes commencent au tri du tableau.
Merci de déceler mes erreurs dans code ci-dessous.
Avec mes remerciements anticipés.
NB: fichier joint modifié.
VB:
Option Explicit
Option Compare Text
Sub Regroupe_Sous_Total()
Dim F_Cmpt As Worksheet, d1 As Object, TbRes(), tbd, dl As Long, Ncol As Byte, ligne As Long
Dim clé, lig As Integer, col As Byte, a()
Set d1 = CreateObject("Scripting.Dictionary")
Set F_Cmpt = Sheets("comptes")
tbd = F_Cmpt.Range("A2:F" & F_Cmpt.[A65000].End(xlUp).Row).Value
dl = F_Cmpt.Range("a" & Rows.Count).End(xlUp).Row
With F_Cmpt.Range("A6:L" & dl)
tbd = Application.Index(.Value, Evaluate("row(1:" & .Rows.Count & ")"), Array(3, 4, 6, 7, 10, 11))
End With
ReDim TbRes(1 To UBound(tbd), 1 To 6)
For ligne = 1 To UBound(tbd)
clé = tbd(ligne, 1)
If d1.exists(clé) Then
lig = d1(clé)
Else
d1(clé) = d1.Count + 1
lig = d1.Count ' index
TbRes(lig, 1) = tbd(ligne, 1)
TbRes(lig, 2) = tbd(ligne, 2)
TbRes(lig, 4) = tbd(ligne, 5)
TbRes(lig, 5) = tbd(ligne, 6)
End If
col = IIf(tbd(ligne, 5) = "Dépenses", 3, 4)
TbRes(lig, 3) = TbRes(lig, 3) + tbd(ligne, col)
Next ligne
'tri croissant Tbd 1ère colonne
Tri TbRes(), 1, LBound(TbRes, 1), UBound(TbRes, 1)
'tri croissant TbRes 2ème colonne
Tri TbRes(), 2, LBound(TbRes, 1), UBound(TbRes, 1)
Feuil11.[a1].Resize(d1.Count, 6).ClearContents
Feuil11.[a1].Resize(d1.Count, 6) = TbRes
End Sub
' TRI D'UN ARRAY 2D via la colonne N°colTri
' a() = le tableau à trier
' gauc = indice bas du tableau
' droi = indice haut du tableau
' colTri = la colonne sur laquelle on effectue le tri
' http://boisgontierjacques.free.fr/
Sub Tri(TbRes(), ColTri, gauc, droi) ' Quick sort
Dim ref, g, d, k As Integer, temp
ref = TbRes((gauc + droi) \ 2, ColTri)
g = gauc: d = droi
Do
Do While TbRes(g, ColTri) < ref: g = g + 1: Loop
Do While ref < TbRes(d, ColTri): d = d - 1: Loop
If g <= d Then
For k = LBound(TbRes, 2) To UBound(TbRes, 2)
temp = TbRes(g, k): TbRes(g, k) = TbRes(d, k): TbRes(d, k) = temp
Next k
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call Tri(TbRes, ColTri, g, droi)
If gauc < d Then Call Tri(TbRes, ColTri, gauc, d)
End Sub
Dernière édition:
