Soyez le premier à donner votre avis sur cette source.
Snippet vu 11 462 fois - Téléchargée 34 fois
Option Explicit '==================================================================== '= MultiTBL '= Créé par T Bertrand - TbeSoft - 2004 '==================================================================== ' ' ' Classe MultiTbl: Tableau à n dimensions redimentionables ' ' Propriétés: ' ' Lecture seule: ' NbDim: renvoie le nombre de dimensions ' UBounds: Renvoie un tableau contenant la taille de chaque dimension ' DimUBound(Index): renvoie la taille de la dimension Index ' Lecture - Ecriture ' Item (Idx1, Idx2, ... Idxn) : Accède à l'élément de tableau ' ' Methodes ' Init Nb1, Nb2, ... Nbn : Initialise un tableau de dimension n ' Redefine Nb1,Nb2, ... , NbN: Redefini le tableau en modifiant les tailles ' et en conservant les anciennes valeurs ' ' Private LtblList As Collection Private LDim As Integer Private LDimensions() As Long Public Property Get NbDim() As Integer NbDim = LDim End Property Public Property Get DimUBound(Index As Integer) As Long Dim tbl() As Long Dim I As Long Dim lst As Long Dim One(1) As Long For I = 1 To LDim ReDim Preserve tbl(I) tbl(I) = LstDim(I, LtblList) Next I DimUBound = tbl(Index) End Property Public Property Get Item(ParamArray Index()) As Variant Dim I As Long Dim LLst As Collection Set LLst = LtblList For I = 1 To LDim - 2 Set LLst = LLst(Index(I - 1)) Next I Item = LLst(Index(LDim - 2))(Index(LDim - 1)) End Property Public Property Let Item(ParamArray Index(), Valeur As Variant) Dim I As Long Dim LLst As Collection Dim tbl() As Variant Set LLst = LtblList For I = 1 To LDim - 2 Set LLst = LLst(Index(I - 1)) Next I tbl = LLst(Index(LDim - 2)) tbl(Index(LDim - 1)) = Valeur LLst.Remove Index(LDim - 2) If Index(LDim - 2) > LLst.Count Then LLst.Add tbl Else LLst.Add tbl, , Index(LDim - 2) End If End Property Public Property Get UBounds() As Long() Dim tbl() As Long Dim I As Long Dim lst As Long For I = 1 To LDim ReDim Preserve tbl(I) tbl(I) = LstDim(I, LtblList) Next I UBounds = tbl End Property Private Function LstDim(ByVal Rang As Integer, lst As Collection) As Long Dim LLst As New Collection Dim I As Long Set LLst = lst For I = 1 To Rang - 1 If I < LDim - 1 Then Set LLst = LLst(1) End If Next I If Rang = LDim Then LstDim = UBound(LLst(1)) Else LstDim = LLst.Count End If End Function Public Sub Init(ParamArray Dimensions()) Dim I As Long Dim J As Long Dim lst As Collection I = Dimensions(0) ReDim LDimensions(UBound(Dimensions)) For J = 0 To UBound(Dimensions) LDimensions(J) = Dimensions(J) Next J Set LtblList = New Collection For J = 1 To I AjouteDim LtblList, 1 Next J LDim = UBound(Dimensions) + 1 End Sub Public Sub Redefine(ParamArray Dimensions()) Dim I As Long Dim J As Long Dim lst As Collection Dim OldDim() As Long Dim newList As Collection If UBound(Dimensions) <> LDim - 1 Then Exit Sub End If I = Dimensions(0) ReDim OldDim(LDim - 1) For J = 0 To UBound(Dimensions) OldDim(J) = LDimensions(J) LDimensions(J) = Dimensions(J) Next J Set newList = New Collection For J = 1 To I If J <= LtblList.Count Then Affecte LtblList(J), newList, 1 Else AjouteDim newList, 1 End If Next J Set LtblList = newList End Sub Private Sub Affecte(L1 As Collection, L2 As Collection, Rang As Long) Dim I As Long Dim J As Long Dim K As Long Dim LLst As Collection Dim tbl() As Variant I = LDimensions(UBound(LDimensions)) J = LDimensions(Rang) If Rang = UBound(LDimensions) Then ReDim tbl(I) If L1.Count >= L2.Count + 1 Then For K = 1 To I If K <= UBound(L1(L2.Count + 1)) Then tbl(K) = L1(L2.Count + 1)(K) Next K End If L2.Add tbl Else Set LLst = New Collection For K = 1 To J If K <= L1.Count Then If Rang < LDim - 2 Then Affecte L1(K), LLst, Rang + 1 Else Affecte L1, LLst, Rang + 1 End If Else AjouteDim LLst, Rang + 1 End If Next K L2.Add LLst End If End Sub Private Sub AjouteDim(L2 As Collection, ByVal Rang As Long) Dim I As Long Dim J As Long Dim K As Long Dim LLst As Collection Dim tbl() As Variant I = LDimensions(UBound(LDimensions)) J = LDimensions(Rang) If Rang = UBound(LDimensions) Then ReDim tbl(I) L2.Add tbl Else Set LLst = New Collection For K = 1 To J AjouteDim LLst, Rang + 1 Next K L2.Add LLst End If End Sub
Tout d'abord, c'est quoi trier un tableau à n dimensions?
Je vois au moins trois réponses:
1)- on trie une colonne (ou ligne) et on lie les éléments des autres colonnes (ou lignes) à ceux triés. (ex: (tri ((1 3 2) (d b a) (5 3 5)) sur la colonne 1 -> ((1 2 3) (d a b) (5 5 3))
2)- On trie uniquement une colonne (ou ligne)
3)- on truie toutes les colonnes (lignes) indépendemment.
je pense que potentiellement, la solution 1 me semble la meilleure, mais pourquoi ne pas implémenter les deux sous forme de méthodes.
il ne reste plus qu'à implémenter ces méthodes dans la classe en question.
J'y réfléchirai si j'ai le temps (bien que VB ne soit plus utilisable sous windows 7) voir même une implémentation sous dot.net.
non 5 mais 9/10
Beau travail
Dim MonTableau As New multitbl
Private sub Command1-Click()
MonTableau.init 2, 3, 7
end sub
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.