[VBA] Les tableaux (le ki ki de Zon)

[FAQ XLD]

On travaillera sur Tableau de 4 colonnes et N lignes dans les différents exemples


INTRODUCTION : Qu’est-ce qu’un Tableau en VBA ?

Un tableau permet de travailler sur un groupe de valeurs qu’on peut traiter de manière individuelle.=>Avec Excel c’est facile de schématiserr puisque ce n’est qu’une feuille de calcul avec un nombre de lignes et de colonnes.

Ex : On veut stocker dans des variables 20 contributeurs du Forum, on pourrait déclarer :

Dim Nom1 as string, Nom2 as string, …, Dim Nom20 as string
Nom1=range(“A1”).value
Nom2=range(“A2”).value
…
Nom20=range(“A20”).value

On se rend compte que cela devient vite pénible à faire, pour pallier à ce problème on utilise des tableaux en programmation.

1)Les Tableaux Unidimensionnels : 1 dimension.

Reprenons les contributeurs XLD :

Déclaration du Tableau : Dim TabContributeurs (19) as string

Le tableau TabContributeurs est donc constitué de 20 éléments qui accueilleront des données de type String (Ex : les noms des contributeurs). Avec les tableaux l’indexation des éléments commence à 0. Il y a possibilité de démarrer l’indexation à 1 avec l’option Base 1=> à mettre en haut d’un module. Sinon de manière explicite:

Dim TabContributeurs (0 to 19) as string ou Dim TabContributeurs (1 to 20) as string

Assignons les pseudos en admettant que les noms soient stockés en A1:A20.

Sub RemplirTab()
Dim I As Byte, TabContributeurs(1 To 20) For I = 1 To 20
TabContributeurs(I) = Range("A" & I)
Next I
End Sub

Il serait intéressant de stocker aussi les prénoms, le courriel et la ville de nos contributeurs, on se retrouve donc avec un tableau de 20 lignes sur 4 colonnes. On parle alors de Tableaux Multidimensionnels.


2) Les Tableaux Multidimensionnels

Pour la déclaration c’est le même principe :

En base 0=> Dim TabContributeurs(0 To 19,0 to 3) as string

En base 1=> Dim TabContributeurs(1 To 20,1 to 4) as string

Les données sont sur la plage A120

Sub RemplirTab2()
Dim I As Byte, J As Byte, TabContributeurs(1 To 20, 1 To 4) 
For I = 1 To 20 
For J = 1 To 4 
TabContributeurs(I, J) = Cells(I, J) 
Next J 
Next I 
End Sub

On peut écrire aussipropre au VBA Excel)

Dim TabContributeurs(1 To 20, 1 To 4)as string
TabContributeurs= Range("A120")

Pour mettre le résultat

Range("E1:H20")= TabContributeurs

ATTENTION: : Sous Excel 97 et MAC, quand on affecte une plage de cellules à un tableau, il ne faut pas déclarer de variable Tableau mais tout simplement en Variant=> .Dim TabContributeurs et non Dim TabContributeurs()

Enfin, même si on affecte qu’une colonne=>TabContributeurs=Range("A1:A20"),on aura un tableau bidimensionnel de 20 lignes sur une colonne.(Ubound(TabContributeurs,1)=20 et Ubound(TabContributeurs,1)=1

Ce qu'on vient de survoler rapidement, on les appelle des tableaux statiques c'est-à-dire qu’on connaît le nombre de lignes et de colonnes en les définissant à la déclaration, Passons aux



3) Les Tableaux dynamiques


A) Agrandissement d'un tableau:

Si on ne connaît pas le nombre de lignes ou de colonnes d’un tableau, on déclare alors :

1er exemple:

Dim TabContributeurs()

Particularités liées à Excel, pour avoir la dernière ligne avec la propriété End.

TabContributeurs=Range ("A1:D" & Range("D65536").End(xlUp).Row)

Ecrit de cette façon, les tableaux en VBA sont toujours en Base 1, donc TabContributeurs est en base 1.
VBA permet de connaître les limites inférieures et supérieures d’un tableau avec LBound et UBound. (toujours le même exemple).

Pour les lignes=> LBound(TabContributeurs,1)=1 et UBound(TabContributeurs,1)=20
Pour les colonnes=> LBound(TabContributeurs,2)=1 et UBound (TabContributeurs,2)=4

2 eme exemple :

Dim TabContributeurs (1 to 20)

Pour rajouter des données dans un tableau il faut l’agrandir, pour cela on utilise

Redim TabContributeurs(1 to 21), ici on rajoute 1 élément.

L’instruction ReDim permet de redimensionner mais efface en même temps tous les éléments du tableau.

On utilise alors

ReDim Preserve TabContributeurs (1 to 22)

On peut agrandir un tableau en même temps qu’on le construit le tableau :

Ex en Base 0:

Dim TabContributeurs() 
For I = 0 To 20 
ReDim Preserve TabContributeurs(I) 
TabContributeurs(I) = I 
Next I

Même si on a vu plus haut, qu'affecter un plage de cellules à un tableau retournait un tableau en Base 1. On peut quand même mettre un tableau en base 0 dans une plage de cellules, on écrira:

Range("A1:U1") = TabContributeurs

Pour mettre sur une colonne un tableau unidimensionel, il suffit juste de transposer le tableau:

Range("A1:A21") = Application.Transpose(TabContributeurs)

=> Jusqu'à Excel 2002, Application.Transpose est limité à 5700 et quelques éléments. (On y reviendra un peu plus bas)

ATTENTION: Pour un tableau multidimensionnel seule la dernière dimension peut être changée. Dim TabContributeurs(1 To 20, 1 To 4)

Ecrire ReDim Preserve TabContributeurs(1 to 21, 1 To 5) provoquera une erreur

Par contre ReDim Preserve TabContributeurs(1 to 20, 1 To 5) est correct.

On a vu plus haut qu’on pouvait écrire :

TabContributeurs= Range("A120")

Pour mettre le résultat

Range("E1:H20")= TabContributeurs

Mais si on connaît pas le nombre de lignes et colonnes on va utiliser Resize(Nb de lignes,Nbde colonnes). Rappel : Le nombre de Lignes d’un tableau est donné par !UBound(TabContributeurs,1) et le nombre de colonnes par !UBound(TabContributeurs,2). Donc :

En base 1=>Range("A1").Resize(UBound(TabContributeurs),UBound(TabContributeurs, 2)) = TabContributeurs

En base 0=>Range("A1").Resize(UBound(TabContributeurs)+1,UBound(TabContributeurs, 2)+1) = TabContributeurs

Au passage écrire

UBound(TabContributeurs) est identique à !UBound(TabContributeurs,1).

B) Construction d'un tableau :

On a vu que seule la dernière dimension pouvait être redimensionnée,

Admettons qu’on est toujours notre tableau de contributeurs ; On veut tous les Thierry avec leur Prénom, nom et adresse.

Il nous faut donc un tableau de 3 colonnes(Nom,Prénom, Adresse) mais comme on ne connaît pas le nombre de Thierry, on va construire un tableau à l’envers

1 er exemple, en Base 0 :

Sub RechercheLesThierryEnBaseZéro()
Dim Tabcontributeurs 
Dim Temp() 'c'est dans ce tableau que l'on va mettre les items trouvé 
Dim J& 'Compteur 
Tabcontributeurs = Range("A1:D5000") 'Le tableau de départ 
For I = 1 To UBound(Tabcontributeurs, 1) 
If Tabcontributeurs(I, 2) = "Thierry" Then 'les prénoms sont en 2 ème colonne 
ReDim Preserve Temp(2, J) 
Temp(0, J) = Tabcontributeurs(I, 1) 'Nom 
Temp(1, J) = Tabcontributeurs(I, 1) '¨Prenom 
Temp(2, J) = Tabcontributeurs(I, 1) 'Adresse 
J = J + 1 
End If 
Next I 
' On met le résultat dans la feuille 2, il faut transposer le tableau puisqu’il est inversé Sheets(2).Range("A1").Resize(UBound(Temp, 2), UBound(Temp, 1)) = Application.Transpose(Temp) 
End Sub

2 ème exemple, en Base 1 en passant par une fonction qui retourne un tableau

Sub RechercheLesThierryEnBase1ParAppeldeFonction()
Dim Tabcontributeurs 
Dim Temp 'En variant cette fois on ne sait pas ce que va nous retourner la fonction 
Dim J& 'Compteur 
Tabcontributeurs = Range("A1:D5000") 'Le tableau de départ 
Temp = RechPrenom(Tabcontributeurs, 2, "Thierry") ‘Appel de la fonction dont on affecte le résultat à Temp 
'On teste si la fonction RechPrenom nous retourne un tableau 
If IsArray(Temp) Then 'On met le résultat 
Sheets(2).Range("A1").Resize(UBound(Temp, 2) + 1, UBound(Temp, 1) + 1) = Application.Transpose(Temp) 
Else 'On affiche qu'on a pas trouvé de Thierry 
MsgBox Temp 
End If 
End Sub

Function RechPrenom(T, Colonne As Byte, Chaine As String) 
Dim I&, J&, K&, Temp() 
J = 1 'On travaille en Base 1 
For I = LBound(T) To UBound(T) 
If T(I, Colonne) = Chaine Then 
ReDim Preserve Temp(1 To 3, 1 To K) 
'On passe par une boucle cette fois 
For K = 1 To 3 
Temp(K, J) = T(I, Colonne) 
Next K 
J = J + 1 
End If 
Next I 
If J > 2 Then 'On a récupéré au moins un Thierry 
'On affecte le tableau Temp à la fonction 
RechPrenom = Temp 
Else 'On affecte une chaine de caractere 
RechPrenom = "Pas de Thierry trouvé" 
End If 
'On peut écrire ce test comme ceci: 
'RechPrenom = IIf(J > 2, Temp, "Pas de Thierry trouvé")
End Function

=> 2 fonctions qui remplacent Application.transpose :

:La 1 ère pour les tableaux bidimensionnels :

Function InverseTab(T, Optional Base As Byte = 0)'Zon 
‘Base par défaut est à 0 mais si on est en base 1 lui donnner la valeur 1 
Dim Temp(), I&, J& 
ReDim Temp(Base To UBound(T, 2), Base To UBound(T)) 
For I = LBound(T, 2) To UBound(T, 2) 
For J = LBound(T) To UBound(T) 
Temp(I, J) = T(J, I) 
Next J 
Next I 
InverseTab = Temp 
End Function

Une 2ème pour les tableaux uni et bidimensionnels :

Function TransposeGrandTab(T) 'Zon 
'Application.transpose est limité à 5000 et qques éléments jusqu'à XL2002 
Dim Temp, I&, J&, Z As Byte, Nb As Byte 
On Error Resume Next 
Do 
Nb = Nb + 1 
Z = UBound(T, Nb + 1) ‘Pour un tableau unidimensionnel ubound(t,2) renvoie une erreur 
Loop Until Err 
If Nb = 1 Then 
ReDim Temp(UBound(T), 1 To 1) 
For I = LBound(T) To UBound(T) 
Temp(I, 1) = T(I) 
Next I 
Else 
ReDim Temp(1 To UBound(T, 2), 1 To UBound(T, 1)) 
For I = 1 To UBound(T, 2) 
For J = 1 To UBound(T, 1) 
Temp(I, J) = T(J, I) 
Next J 
Next I 
End If 
TransposeGrandTab = Temp 
End Function

Exemple d'utilisation:

Sub RechercheLesThierryEnBase1ParAppeldeFonction() 
Dim Tabcontributeurs 
Dim Temp 'En variant cette fois on ne sait pas ce que va nous retourner la fonction 
Dim J& 'Compteur 
Tabcontributeurs = Range("A1:D5000") 'Le tableau de départ 
Temp = RechPrenom(Tabcontributeurs, 2, "Thierry") ‘Appel de la fonction dont on affecte le résultat à Temp 
'On teste si la fonction RechPrenom nous retourne un tableau 
If IsArray(Temp) Then 'On met le résultat 
Temp=TransposeGrandTab(Temp) 'ou Temp=InverseTab(Temp,1) 
Sheets(2).Range("A1").Resize(UBound(Temp, 2) + 1, UBound(Temp, 1) + 1) = Temp 
Else 'On affiche qu'on a pas trouvé de Thierry 
MsgBox Temp 
End If 
End Sub

4) Tri d'un tableau

En programmation, les algorithmes de tri sont nombreux, j'en avais étudié 7 quand je faisais du C, mais tout cela je l'ai oublié. On va voir 2 types de tri: le plus lent (Bubblesort) et un des plus rapides (le quicksort).

=>Le bubblesort ou le tri à bulle en français, C'est un des plus connus car c'est le plus facile à programmer. Son principe est de comparer chaque élément d'un tableau avec son suivant pour échanger leur place le cas échéant.

Voici une façon de l'écrire, la variable senstri permet de trier croissant ou décroissant

Sub TriaBulle(T, Optional SensTri As Boolean = True) 'Zon 
Dim Test As Boolean, I&, Temp 
Do 
Test = False 
For I = LBound(T) To UBound(T) - 1 
If (T(I) > T(I + 1) And SensTri) Or (T(I) < T(I + 1) And Not SensTri) Then 
Temp = T(I) 
T(I) = T(I + 1) 
T(I + 1) = Temp 
Test = True 
End If 
Next I 
Loop Until Not Test 
End Sub

Cet algo est conseillé pour trier des tableaux de moins 1000 éléments, donc pour trier une listbox dans un userform il est trés pratique. @+Thierry l'utilise d'ailleurs dans ses démos.

=>Quicksort ou le tri rapide encore appelé tri dichotomique C'est le plus rapide dans la plupart des cas, du moins sur Excel car on a rarement des tableaux de plus de 65000 éléments. Son principe consiste à trier une partie d'un tableau délimité par 2 indices, on choisit une valeur de ce tableau qui servira de pivot qu'on place de manière définitive de manière à ce que tous les éléments précdents ce pivot lui soient inférieurs ou égaux et que tous les suivants lui soient supérieurs ou égaux. On prend comme pivot la valeur médiane. Dnas les 2 exemples ci dessous , le tri est fait de manière récursive. Pour un tableau à 1 dimension, une procédure de Ti.

Sub TrieTableau(Deb As Long, Fin As Long)'Ti 
Dim IndiceInf As Long, IndiceSup As Long 
Dim Temp1, Pivot 
IndiceInf = Deb 
IndiceSup = Fin 
Pivot = UCase(T((Deb + Fin) \ 2)) 
Do 
While UCase(T(IndiceInf)) < Pivot 
IndiceInf = IndiceInf + 1 
Wend 
While Pivot < UCase(T(IndiceSup)) 
IndiceSup = IndiceSup - 1 
Wend 
If IndiceInf <= IndiceSup Then 
Temp1 = T(IndiceInf) 
T(IndiceInf) = T(IndiceSup) 
T(IndiceSup) = Temp1 
IndiceInf = IndiceInf + 1 
IndiceSup = IndiceSup - 1 
End If 
Loop Until IndiceInf > IndiceSup 
If Deb < IndiceSup Then TrieTableau Deb, IndiceSup 
If IndiceInf < Fin Then TrieTableau IndiceInf, Fin 
End Sub

Pour un tableau à 2 dimensions, pratique pour trier une plage de cellules par exemple:

T=range("A1:C50000").value

'On veut trier le tableau sur la colonne B:

Trimulti T,2,lbound(T),Ubound(T)

Sub TriMulti(Tablo, Col As Byte, Min&, Max&) 'ZOn 
Dim I&, J&, K&, M, Chaine 
I = Min 
J = Max 
M = Tablo((Min + Max) / 2, Col) 
While (I <= J) 
While (Tablo(I, Col) < M And I < Max) 
I = I + 1 
Wend 
While (M < Tablo(J, Col) And J > Min) 
J = J - 1 
Wend 
If (I <= J) Then 
For K = LBound(Tablo, 2) To UBound(Tablo, 2) 
Chaine = Tablo(I, K) 
Tablo(I, K) = Tablo(J, K) 
Tablo(J, K) = Chaine 
Next K 
I = I + 1 
J = J - 1 
End If 
Wend 
If (Min < J) Then TriMulti Tablo, Col, Min, J 
If (I < Max) Then TriMulti Tablo, Col, I, Max 
End Sub