1. Accueil
  2. Tous les snippets
  3. Snippets Visual Basic / VB.NET
  4. Classe vb tableaux multi dimentionnels redilmentionables sur toutes les dimensions

Classe vb tableaux multi dimentionnels redilmentionables sur toutes les dimensions

Soyez le premier à donner votre avis sur cette source.

Snippet vu 11 426 fois - Téléchargée 34 fois

Commenter

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)

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

Ajouter un commentaire

Commentaires

Signaler
Messages postés
6
Date d'inscription
vendredi 6 juin 2003
Statut
Membre
Dernière intervention
30 mars 2016
Bonne question:
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.
Signaler
Messages postés
309
Date d'inscription
lundi 16 décembre 2002
Statut
Membre
Dernière intervention
15 juin 2015
 1
Super source. Mais comment faire pour trier un tableau à plusieurs dimensions ?
Signaler
Messages postés
30
Date d'inscription
mercredi 18 décembre 2002
Statut
Membre
Dernière intervention
11 décembre 2009
Je me suis tromper dans la note
non 5 mais 9/10
Beau travail
Signaler
Messages postés
30
Date d'inscription
mercredi 18 décembre 2002
Statut
Membre
Dernière intervention
11 décembre 2009
Merci sa marche
Signaler
Messages postés
6
Date d'inscription
vendredi 6 juin 2003
Statut
Membre
Dernière intervention
30 mars 2016
Il faut définir un objet de type MultiTBL, si MultiTbl est le nom de la classe, avant de le référencer comme ci dessous


Dim MonTableau As New multitbl

Private sub Command1-Click()
MonTableau.init 2, 3, 7
end sub
Afficher les 8 commentaires
S'inscrire maintenant

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.

Du même auteur (fregoli)