Classe vb tableaux multi dimentionnels redilmentionables sur toutes les dimensions
Soyez le premier à donner votre avis sur cette source.
Snippet vu 11 500 fois - Téléchargée 35 fois
Contenu du snippet
Ce module de classe implémente un tableau multidimentionnel sans limite, permettant de redimentionner n'importe quelle sous ensemble de dimension.
Classe : multitbl
Permet de faire ce que ne permet pas Redim Preserve
MaTable.int 5,3,12 -> dimentionne un tableau vierge 5 X 3 X 12 Elements
MaTable.Redefine 7 X 2 X 5 -> redéfini l'ancien tableau en conservant les anciens éléments
Juste faire copier coller du source dans un nouveau module de classe
Propriétés:
NbDim -> Renvoie le nombre de dimensions
UBounds -> renvoie un tableau contenant le nombre d'éléments de chaque dimension
DimUbouns(Index) -> Renvoie le nb d'éléments de la dimension Index
Item (Index1,Index2, ... ,Indexn) -> Propriété en lecture - écriture d'accès à l'élément du tableau
Méthodes:
Init (Nb1, Nb2, ..., Nbn) -> défini un tableaux de n dimensions
Redefine (Nb1, Nb2, ... Nbn) -> redéfini le nombre d'éléments des n dimensions (on ne peut pas changer le nombre de dimensions)
Classe : multitbl
Permet de faire ce que ne permet pas Redim Preserve
MaTable.int 5,3,12 -> dimentionne un tableau vierge 5 X 3 X 12 Elements
MaTable.Redefine 7 X 2 X 5 -> redéfini l'ancien tableau en conservant les anciens éléments
Juste faire copier coller du source dans un nouveau module de classe
Propriétés:
NbDim -> Renvoie le nombre de dimensions
UBounds -> renvoie un tableau contenant le nombre d'éléments de chaque dimension
DimUbouns(Index) -> Renvoie le nb d'éléments de la dimension Index
Item (Index1,Index2, ... ,Indexn) -> Propriété en lecture - écriture d'accès à l'élément du tableau
Méthodes:
Init (Nb1, Nb2, ..., Nbn) -> défini un tableaux de n dimensions
Redefine (Nb1, Nb2, ... Nbn) -> redéfini le nombre d'éléments des n dimensions (on ne peut pas changer le nombre de dimensions)
Source / Exemple :
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
A voir également
- Dimentionnel
- Nbdim - Meilleures réponses
- Tableau multi - Meilleures réponses
- Déclarer et remplir un tableau multi-dimentionnel ✓ - Forum - VB.NET
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.
- Messages postés
-
308
- Date d'inscription
- lundi 16 décembre 2002
- Statut
- Membre
- Dernière intervention
- 15 juin 2015
1non 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.