VBA : Variables tableaux - fonctions utiles
Voici quelques fonctions opérantes sur les variables tableaux.
- Introduction
- Ajouter un Index à un tableau
- Extraire une Colonne à un tableau
- Filtrer une variable tableau
- Inverser une variable tableau
- Nombre de dimensions d'un tableau
- Passer les valeurs d'un Range au tableau
- Déterminer le numéro de colonne dans un tableau
- Déterminer l'index d'un élément dans un tableau
- Supprimer un élément dans un tableau
- Transposer une variable tableau
- Tri d'un tableau à 1 dimension
- Tri d'un tableau à 2 dimensions
- Téléchargement
Introduction
Le but de ces codes est de réaliser certaines fonctionnalités (filtre, tri, etc) d'excel, en ne travaillant qu'en mémoire vive et pas sur les cellules. Cela permet un gain de temps pour vos procédures et macros.
Ces fonctions sont prêtes à l'emploi. Cependant, si vous y dénichez des erreurs (et je ne doute pas qu'il y en ait), merci de bien vouloir me les signaler par messagerie privée ou sur le forum.
Je vous recommande de placer toutes ces fonctions et procédures dans un module. Ainsi elles pourront être facilement mises à disposition dans chacun de vos classeurs. Un module complet est à votre disposition au paragraphe téléchargement.
Pour ne pas refaire ce qui existe et a été très bien réalisé, je vous recommande cette lecture afin de vous familiariser avec les variables tableaux et la syntaxe qui va avec...
Ajouter un Index à un tableau
Ajoute un élément (ou une ligne d'éléments) à un array (1 ou 2 dimensions) et lui attribue un index précis.
Retourne True si tout s'est bien passé, False et un message d'erreur explicit dans le cas contraire.
Attention : | utilise la fonction : Nb_Dimensions |
A lire : source partielle
Paramètres :
- Tableau : doit être déclaré comme Variant, pas comme une variable tableau donc sans les parenthèses. exemple : Dim monTab ou Dim MyTbl As Variant
- Index : doit être compris entre le premier indice du Tableau et le dernier indice + 1
- Textos :
- en cas de Tableau à 1 dimension ne doit pas être un Array ==> 1 seule valeur, ex : Texte = "toto"
- en cas de Tableau à 2 dimensions doit être un Array ==> ex : Textes = Array("toto", "titi", "tata")
Public Function Ajoute_Index(ByRef Tableau As Variant, _ Index As Long, _ Textos As Variant) As Boolean Ajoute_Index = False If Index < LBound(Tableau) Or Index > UBound(Tableau) + 1 Then GoTo Erreur_Index Select Case Nb_Dimensions(Tableau) Case 1 '===== le présent code, déposé par ucfoutu sur VBFrance, est la seule propriété de VBFrance '=====VBFrance en autorise les libres copie et utilisation à la seule condition d'y laisser '=====insérées les trois présentes lignes commentées 'solution sans ReDim ni Preserve If Nb_Dimensions(Textos) > 0 Then GoTo Erreur_Textos If Index = UBound(Tableau) + 1 Then Tableau(Index - 1) = Tableau(Index - 1) & Chr(0) & Chr(0) Else Tableau(Index) = Chr(0) & Chr(0) & Tableau(Index) End If Dim Tbl On Error GoTo Erreur_Tableau Tbl = Split(Replace(Join(Tableau, Chr(0)), Chr(0) & Chr(0), Chr(0)), Chr(0)) Tbl(Index) = Textos Tableau = Tbl '========================= On Error GoTo 0 Erase Tbl Ajoute_Index = True Case 2 If Nb_Dimensions(Textos) = 1 Then Dim tabl(), j As Long, i As Long 'solution avec ReDim et Preserve On Error GoTo Erreur_Tableau ReDim Preserve tabl(LBound(Tableau, 1) To UBound(Tableau, 1) + 1, LBound(Tableau, 2) To UBound(Tableau, 2)) For i = LBound(Tableau, 1) To Index - 1 For j = LBound(Tableau, 2) To UBound(Tableau, 2) tabl(i, j) = Tableau(i, j) Next Next For i = Index To UBound(Tableau, 1) For j = LBound(Tableau, 2) To UBound(Tableau, 2) tabl(i + 1, j) = Tableau(i, j) Next Next For j = LBound(Textos) To UBound(Textos) tabl(Index, j + 1) = Textos(j) Next Tableau = tabl On Error GoTo 0 Erase tabl Ajoute_Index = True Else GoTo Erreur_Textos End If Case Else MsgBox "Votre Tableau ne comporte pas le nombre de dimension adéquat. Fonction non traitée." End Select Exit Function Erreur_Tableau: MsgBox "Votre Tableau n'a pas été déclaré comme il convient." Exit Function Erreur_Textos: MsgBox "Le dernier paramètre de la fonction n'est pas valide." Exit Function Erreur_Index: MsgBox "Index non valide" End Function
Extraire une Colonne à un tableau
Va créer une variable tableau à une dimension à partir d'une variable tableau multidimensionnelle, en extrayant les données d'une colonne de ce tableau.
Retourne donc une variable tableau de type Variant à une dimension.
Attention : | utilise la fonction : Nb_Dimensions |
Paramètres :
- Tableau = Array de variant à 2 dimensions
- Colonne = numéro de la colonne contenant les données à extraire
Public Function Extrait_Colonne(ByVal Tableau As Variant, _ Colonne As Long) As Variant Dim Tbl() As Variant, i As Long, TestColonne As Variant On Error GoTo Erreur_Colonne TestColonne = Tableau(LBound(Tableau, 1), Colonne) On Error GoTo 0 Select Case Nb_Dimensions(Tableau) Case 0 MsgBox "Le tableau passé en paramètre est vide.": Exit Function Case 1 MsgBox "Le tableau passé en paramètre ne comporte qu'une colonne." Exit Function Case 2 ReDim Tbl(UBound(Tableau, 1)) For i = LBound(Tableau, 1) To UBound(Tableau, 1) Tbl(i) = Tableau(i, Colonne) Next End Select Extrait_Colonne = Tbl Erase Tbl Exit Function Erreur_Colonne: MsgBox "Le paramètre Colonne est erroné." End Function
Filtrer une variable tableau
Filtre un tableau à 2 dimensions en fonction du contenu d'une colonne.
Retourne un tableau à 2 dimensions de type Variant.
Attention : | utilise les fonctions : Nb_Dimensions & Transposition & Retourne_Colonne |
Paramètres :
- Tableau = Array de variant à 2 dimensions
- Item = Au choix : numéro de la colonne ou valeur à chercher dans le tableau
- Key1 = comparateur, donnée à laquelle comparer les données de la colonne Colonne
- Test = opérateur parmi : "=", "<", "<=", ">", ">=", "Like", "<>" (à passer en String donc avec guillemets)
Public Function Filtre_Tableau(ByVal Tableau As Variant, _ Item As Variant, _ Key1 As Variant, _ Optional test As String = "=") As Variant Dim Tbl() As Variant, i As Long, j As Long, Cpt As Long, Colonne As Long, TestColonne As Variant Select Case VarType(Item) Case 8: Colonne = Retourne_Colonne(Tableau, Item) Case 2, 3, 17: Colonne = CLng(Item) Case Else: GoTo Erreur_Colonne End Select On Error GoTo Erreur_Colonne TestColonne = Tableau(LBound(Tableau, 1), Colonne) On Error GoTo 0 Select Case Nb_Dimensions(Tableau) Case 0 MsgBox "Le tableau passé en paramètre est vide.": Exit Function Case 1 MsgBox "Le tableau passé en paramètre ne comporte qu'une colonne." Exit Function Case 2 If IsDate(Key1) Then Key1 = CDate(Key1) If IsNumeric(Key1) Then Key1 = CLng(Key1) Select Case test Case "=" For i = LBound(Tableau, 1) To UBound(Tableau, 1) If Tableau(i, Colonne) = Key1 Then Cpt = Cpt + 1 ReDim Preserve Tbl(LBound(Tableau, 2) To UBound(Tableau, 2), LBound(Tableau, 1) To Cpt) For j = LBound(Tableau, 2) To UBound(Tableau, 2) Tbl(j, Cpt) = Tableau(i, j) Next j End If Next i Case "<" For i = LBound(Tableau, 1) To UBound(Tableau, 1) If Tableau(i, Colonne) < Key1 Then Cpt = Cpt + 1 ReDim Preserve Tbl(LBound(Tableau, 2) To UBound(Tableau, 2), LBound(Tableau, 1) To Cpt) For j = LBound(Tableau, 2) To UBound(Tableau, 2) Tbl(j, Cpt) = Tableau(i, j) Next j End If Next i Case ">" For i = LBound(Tableau, 1) To UBound(Tableau, 1) If Tableau(i, Colonne) > Key1 Then Cpt = Cpt + 1 ReDim Preserve Tbl(LBound(Tableau, 2) To UBound(Tableau, 2), LBound(Tableau, 1) To Cpt) For j = LBound(Tableau, 2) To UBound(Tableau, 2) Tbl(j, Cpt) = Tableau(i, j) Next j End If Next i Case "<=" For i = LBound(Tableau, 1) To UBound(Tableau, 1) If Tableau(i, Colonne) <= Key1 Then Cpt = Cpt + 1 ReDim Preserve Tbl(LBound(Tableau, 2) To UBound(Tableau, 2), LBound(Tableau, 1) To Cpt) For j = LBound(Tableau, 2) To UBound(Tableau, 2) Tbl(j, Cpt) = Tableau(i, j) Next j End If Next i Case ">=" For i = LBound(Tableau, 1) To UBound(Tableau, 1) If Tableau(i, Colonne) >= Key1 Then Cpt = Cpt + 1 ReDim Preserve Tbl(LBound(Tableau, 2) To UBound(Tableau, 2), LBound(Tableau, 1) To Cpt) For j = LBound(Tableau, 2) To UBound(Tableau, 2) Tbl(j, Cpt) = Tableau(i, j) Next j End If Next i Case "<>" For i = LBound(Tableau, 1) To UBound(Tableau, 1) If Tableau(i, Colonne) <> Key1 Then Cpt = Cpt + 1 ReDim Preserve Tbl(LBound(Tableau, 2) To UBound(Tableau, 2), LBound(Tableau, 1) To Cpt) For j = LBound(Tableau, 2) To UBound(Tableau, 2) Tbl(j, Cpt) = Tableau(i, j) Next j End If Next i Case "Like" For i = LBound(Tableau, 1) To UBound(Tableau, 1) If Tableau(i, Colonne) Like Key1 Then Cpt = Cpt + 1 ReDim Preserve Tbl(LBound(Tableau, 2) To UBound(Tableau, 2), LBound(Tableau, 1) To Cpt) For j = LBound(Tableau, 2) To UBound(Tableau, 2) Tbl(j, Cpt) = Tableau(i, j) Next j End If Next i Case Else MsgBox "Le paramètre facultatif Test est erroné." Exit Function End Select On Error GoTo resultat_Vide TestColonne = Tbl(UBound(Tbl, 1), UBound(Tbl, 2)) On Error GoTo 0 Filtre_Tableau = Transposition(Tbl) Erase Tbl Case Else MsgBox "Le tableau comporte plus de deux dimensions. La fonction n'est pas adaptée à ce cas." End Select Exit Function Erreur_Colonne: MsgBox "Le paramètre Item est erroné." Exit Function resultat_Vide: MsgBox "Le filtre renvoie un tableau vide de données." End Function
Inverser une variable tableau
Inverse les éléments d'un tableau (1 ou 2 dimensions). Les premiers seront les derniers!
Retourne True si tout va bien et False + un message dans le cas contraire.
A lire : Source
Attention : | utilise la fonction : Nb_Dimensions |
Paramètre :
- Tableau = Array de Variant à 1 ou 2 dimensions
Public Function Inverse_Tableau(ByRef Tableau As Variant) As Boolean Dim Temp As Variant, IndexDeb As Long, IndexFin As Long, IndexDim2 As Long Inverse_Tableau = False Select Case Nb_Dimensions(Tableau) Case 0 MsgBox "Le tableau passé en paramètre est vide." Case 1 IndexFin = UBound(Tableau) For IndexDeb = LBound(Tableau) To ((UBound(Tableau) - LBound(Tableau) + 1) \ 2) Temp = Tableau(IndexDeb) Tableau(IndexDeb) = Tableau(IndexFin) Tableau(IndexFin) = Temp IndexFin = IndexFin - 1 Next IndexDeb Inverse_Tableau = True Case 2 IndexFin = UBound(Tableau, 1) For IndexDeb = LBound(Tableau, 1) To ((UBound(Tableau, 1) - LBound(Tableau, 1) + 1) \ 2) For IndexDim2 = LBound(Tableau, 2) To UBound(Tableau, 2) Temp = Tableau(IndexDeb, IndexDim2) Tableau(IndexDeb, IndexDim2) = Tableau(IndexFin, IndexDim2) Tableau(IndexFin, IndexDim2) = Temp Next IndexDim2 IndexFin = IndexFin - 1 Next IndexDeb Inverse_Tableau = True Case Else MsgBox "Le tableau comporte plus de deux dimensions." End Select End Function
Nombre de dimensions d'un tableau
Calcule le nombre de dimensions d'un tableau.
Retourne un Integer
Paramètre :
- Tableau = Array de Variant à 0, 1 ou plusieurs dimensions
Public Function Nb_Dimensions(Tableau As Variant) As Integer Dim D As Integer, t As Long On Error GoTo Fin Do: D = D + 1: t = UBound(Tableau, D): Loop Fin: Nb_Dimensions = D - 1 End Function
Passer les valeurs d'un Range au tableau
Converti sans faille un range en tableau. Pallie le problème rencontré si le Range ne contient qu'une cellule.
A lire : Source.
Retourne un tableau, toujours en option base 1 et à 2 dimensions
Paramètre :
- plage = Range (plage de cellule(s))
Public Function Range_To_Tb(Plage As Range) As Variant() If Plage.Cells.Count < 2 Then Dim tablo(1 To 1, 1 To 1) tablo(1, 1) = Plage.Value Range_To_Tb = tablo Erase tablo Else Range_To_Tb = Plage.Value End If End Function
Déterminer le numéro de colonne dans un tableau
Détermine le numéro de colonne d'un élément dans un tableau à 2 dimensions.
Retourne un Long représentant le numéro de colonne de cet élément, -1 si l'élément n'existe pas dans le tableau.
Attention : | utilise la fonction : Nb_Dimensions |
Paramètres :
- Tableau = Array de Variant à 2 dimensions
- Texto = Donnée de type Variant à chercher dans le tableau
Public Function Retourne_Colonne(ByRef Tableau As Variant, _ Texto As Variant) As Long Dim i As Long, j As Integer Retourne_Colonne = -1 Select Case Nb_Dimensions(Tableau) Case 0 MsgBox "Le tableau passé en paramètre est vide." Case 1 MsgBox "Le tableau passé en paramètre n'a qu'une dimension" Case 2 For i = LBound(Tableau, 1) To UBound(Tableau, 1) For j = LBound(Tableau, 2) To UBound(Tableau, 2) If Tableau(i, j) = Texto Then Retourne_Colonne = j: Exit Function Next j Next i Case Else MsgBox "Le tableau comporte plus de deux dimensions." End Select End Function
Déterminer l'index d'un élément dans un tableau
Détermine l'index d'un élément à partir de son contenu
Retourne un Long représentant l'index de cet élément, -1 si l'élément n'existe pas dans le tableau.
Attention : | utilise la fonction : Nb_Dimensions |
A lire : Source partielle
Paramètres :
- Tableau = Array de Variant à 1 ou 2 dimensions
- Texto = Donnée de type String à chercher dans le tableau à la colonne Colonne
- Optional Colonne => indique la colonne du tableau ou chercher la valeur Texto
Public Function Retourne_Index(ByVal Tableau As Variant, _ Texto As String, _ Optional Colonne As Long = 1) As Long Dim i As Long, strTemp As String Retourne_Index = -1 Select Case Nb_Dimensions(Tableau) Case 0 MsgBox "Le tableau passé en paramètre est vide." Case 1 '===== le présent code, déposé par ucfoutu sur VBFrance, est la seule propriété de VBFrance '=====VBFrance en autorise les libres copie et utilisation à la seule condition d'y laisser '=====insérées les trois présentes lignes commentées strTemp = Chr(0) & Join(Tableau, Chr(0)) & Chr(0) i = InStr(strTemp, Chr(0) & Texto & Chr(0)) If i = 0 Then Retourne_Index = -1: Exit Function strTemp = Mid(strTemp, 1, i) Retourne_Index = UBound(Split(strTemp, Chr(0))) - 1 If Retourne_Index < 0 Then Retourne_Index = -1 Exit Function '====================== Case 2 For i = LBound(Tableau, 1) To UBound(Tableau, 1) If Tableau(i, Colonne) = Texto Then Retourne_Index = i: Exit Function Next i End Select End Function
Supprimer un élément dans un tableau
Supprime un élément (ou une ligne d'éléments) par son index ou par son contenu
Retourne un tableau de type Variant.
Attention : | utilise les fonctions : Retourne_Index & Nb_Dimensions |
A lire : Source partielle
Paramètres :
- Tableau = Array de Variant à 1 ou 2 dimensions
- Text_Ou_Index = Donnée de type Variant (String ("mot" à chercher) ou Long (Index du "mot" à chercher)), à chercher dans le tableau
- Optional Colonne => Cas d'un array à 2 dimensions : indique la colonne du tableau ou chercher la valeur Text_Ou_Index
Public Function Supprime_Index(ByRef Tableau As Variant, _ Text_Ou_Index, _ Optional Colonne As Long = 1) As Variant Dim i As Long, Sucf As String If VarType(Text_Ou_Index) = 8 Then Sucf = Text_Ou_Index i = Retourne_Index(Tableau, Sucf, Colonne) Else i = Text_Ou_Index End If If i >= 0 Then Select Case Nb_Dimensions(Tableau) Case 0 MsgBox "Le tableau passé en paramètre est vide." Case 1 '===== le présent code, déposé par ucfoutu sur VBFrance, est la seule propriété de VBFrance '=====VBFrance en autorise les libres copie et utilisation à la seule condition d'y laisser '=====insérées les trois présentes lignes commentées Tableau(i) = "" Sucf = Join(Tableau, Chr(0)) If i = 0 Then Sucf = Mid(Sucf, 2) If i = UBound(Tableau) Then Sucf = Left(Sucf, Len(Sucf) - 1) Supprime_Index = Split(Replace(Sucf, Chr(0) & Chr(0), Chr(0)), Chr(0)) '================== Case 2 Dim j As Long, k As Long, Cpt As Long, Tbl For j = LBound(Tableau, 1) To UBound(Tableau, 1) - 1 If j <> i Then For k = LBound(Tableau, 2) To UBound(Tableau, 2) Cpt = Cpt + 1 ReDim Preserve Tbl(1 To Cpt, 1 To k) Tbl(Cpt, k) = Tableau(j + 1, k) Next k End If Next j Supprime_Index = Tbl Erase Tbl Case Else MsgBox "Le tableau comporte plus de deux dimensions. La fonction n'est pas adaptée à ce cas." End Select Else MsgBox "La valeur à supprimer n'a pas été trouvée dans la variable tableau" End If End Function
Transposer une variable tableau
La fonction Excel Transpose (ou en VBA Application.Transpose) est limitée à 65536 lignes. Cette fonction pallie ce manque pour les grandes variables tableaux.
Retourne un tableau de type Variant.
Attention : | utilise la fonction : Nb_Dimensions |
Paramètre :
- Tableau = Array de Variant
Public Function Transposition(ByRef Tableau As Variant) As Variant Dim tabl, i As Long, j As Long Select Case Nb_Dimensions(Tableau) Case 0 MsgBox "Le tableau passé en paramètre est vide." Case 1 ReDim tabl(LBound(Tableau) To UBound(Tableau), LBound(Tableau) To 1) For i = LBound(Tableau) To UBound(Tableau) tabl(i, LBound(Tableau)) = Tableau(i) Next Transposition = tabl Erase tabl Case 2 ReDim tabl(LBound(Tableau, 2) To UBound(Tableau, 2), LBound(Tableau, 1) To UBound(Tableau, 1)) For i = LBound(Tableau, 1) To UBound(Tableau, 1) For j = LBound(Tableau, 2) To UBound(Tableau, 2) tabl(j, i) = Tableau(i, j) Next j Next i Transposition = tabl Erase tabl Case Else MsgBox "Le tableau comporte plus de deux dimensions" End Select End Function
Tri d'un tableau à 1 dimension
Tri un tableau à 1 dimension.
Retourne le tableau de Variant passé en paramètre, trié.
Basé sur le QuickSort de Boisgontier : http://boisgontierjacques.free.fr/
Paramètres :
- Tableau = Array de Variant
- mini = indice inférieur (ex : LBound(Tableau))
- Maxi = indice supérieur (ex : UBound(Tableau))
Public Sub Tri_1_Dim(ByRef Tableau As Variant, _ mini As Long, _ Maxi As Long) Dim i As Long, j As Long, Pivot As Variant, Temp As Variant On Error Resume Next i = mini: j = Maxi Pivot = Tableau((mini + Maxi) \ 2) While i <= j While Tableau(i) < Pivot And i < Maxi: i = i + 1: Wend While Pivot < Tableau(j) And j > mini: j = j - 1: Wend If i <= j Then Temp = Tableau(i) Tableau(i) = Tableau(j) Tableau(j) = Temp i = i + 1: j = j - 1 End If Wend If (mini < j) Then Call Tri_1_Dim(Tableau, mini, j) If (i < Maxi) Then Call Tri_1_Dim(Tableau, i, Maxi) End Sub
Tri d'un tableau à 2 dimensions
Tri un tableau à deux dimensions.
Retourne le tableau de Variant passé en paramètre, trié selon la colonne donnée en paramètre.
A lire : Source
Paramètres :
- Tableau = Array de Variant
- mini = indice inférieur (ex : LBound(Tableau))
- Maxi = indice supérieur (ex : UBound(Tableau))
- Optional Colonne = la colonne selon laquelle trier le tableau
Public Sub Tri_2_Dim(ByRef Tableau As Variant, _ mini As Long, _ Maxi As Long, _ Optional Colonne As Long = 0) Dim i As Long, j As Long, Pivot As Variant, TableauTemp As Variant, ColTemp As Long On Error Resume Next i = mini: j = Maxi Pivot = Tableau((mini + Maxi) \ 2, Colonne) While i <= j While Tableau(i, Colonne) < Pivot And i < Maxi: i = i + 1: Wend While Pivot < Tableau(j, Colonne) And j > mini: j = j - 1: Wend If i <= j Then ReDim TableauTemp(LBound(Tableau, 2) To UBound(Tableau, 2)) For ColTemp = LBound(Tableau, 2) To UBound(Tableau, 2) TableauTemp(ColTemp) = Tableau(i, ColTemp) Tableau(i, ColTemp) = Tableau(j, ColTemp) Tableau(j, ColTemp) = TableauTemp(ColTemp) Next ColTemp Erase TableauTemp i = i + 1: j = j - 1 End If Wend If (mini < j) Then Call Tri_2_Dim(Tableau, mini, j, Colonne) If (i < Maxi) Then Call Tri_2_Dim(Tableau, i, Maxi, Colonne) End Sub
Téléchargement
Vous trouverez ICI, un module regroupant toutes ces fonctions.
Pour l'intégrer à votre classeur après l'avoir téléchargé :
Sous VBE : Fichier/Importer un fichier
Bonne utilisation.