Utiliser une collection ArrayList à plusieurs dimensions

Des fonctions génériques pour gérer une collection ArrayList à plusieurs dimensions

Laurent Ott

Cette documentation propose des fonctions en VBA pour Excel pour utiliser des listes à plusieurs dimensions avec la collection « Arraylist », car les méthodes de cette collection ne sont bien souvent disponibles que pour des listes à une seule dimension.
Ces fonctions peuvent donc combler un manque.

- Titre : Utiliser une collection ArrayList à plusieurs dimensions

- Auteur : Laurent Ott

- Parution : 21 août 2024

- Mise à jour : 12 octobre 2024

- Licence : Le contenu de cet article est rédigé par Laurent Ott et est mis à disposition selon les termes de la Licence Creative Commons Attribution - Pas d'Utilisation Commerciale 3.0 non transposé. Les logos Developpez.com, en-tête, pied de page, css, et look & feel de l'article sont Copyright ® 2013 Developpez.com.

Voir également :

- Tome 1 - Des bases de la programmation à l'algorithme de classement rapide QuickRanking

- Tome 2 - Des bases de la programmation en mode graphique à la programmation d'un jeu d'arcade en VBA et Microsoft Excel

- Tome 3 - Problème du Voyageur de commerce - Une méthode d'approximation basée sur des principes simples

- Tome 4 - Un algorithme de chiffrement/déchiffrement des cellules pour une meilleure confidentialité

- Tome 5 - Sentinelle - Une application qui veille sur vos classeurs sensibles - Exemples d'utilisations des tableaux de données et des requêtes SQL en VBA

- Tome 6 - Apprendre la programmation de nouvelles fonctions Excel pour l'utilisateur

- Comprendre la méthode de factorisation du Crible Quadratique

- Programmation en VBA de menus personnalisés pour Excel

- Manipuler les données des bases Access depuis Excel

- Transfert des fichiers volumineux sous Outlook

- Algorithme ECM de factorisation par les courbes elliptiques

- Un classeur Excel multi-utilisateur

- Compresser/décompresser des fichiers au format ZIP

- Fonctions en VBA pour gérer les Tableaux Structurés d’Excel

- Des fonctions en VBA pour générer des courriels par les balises HTML

- MsgBox_Perso : une boîte de message personnalisée

- Utiliser une collection ArrayList à plusieurs dimensions

- Fonctions en VBA pour gérer de gros volumes de données

Sommaire

- I. Introduction

- II. Gérer une collection ArrayList à plusieurs dimensions

- II-A. Exercice pour mieux comprendre les fonctions utilisées

- II-B. ListFromRange - Charger des données

- II-C. ListAddList - Concaténer deux listes

- II-D. ListRemove - Supprimer des éléments

- II-E. ListSort - Trier les données

- II-F. ListFromList - Copier certaines colonnes d’une liste dans une autre liste

- II-G. ListUnique - Générer une liste unique

- II-H. ListAddcolumns - Ajouter ou supprimer des colonnes à une liste

- II-I. ListCount - Compter le nombre d’éléments

- II-J. ListSum - Faire la somme d’une colonne

- II-K. ListUpdateItem - Mettre à jour les données

- II-L. ListToTable – Alimenter un tableau structuré

- II-M. ListIndexOf - Connaitre la position d’un élément

- II-N. ListContains - Savoir si un élément existe

- II-O. ListAddItem - Ajouter un élément

- III. Le code source de l’exercice

- IV. ListFromSQL - Exécuter une requête SQL sur une liste

- V. Conclusion

- VI. Remerciements

- VII. Le fichier joint

- VIII. Le code des fonctions pour ceux qui ne peuvent pas télécharger le fichier joint

I - Introduction

La collection « ArrayList » n’est pas souvent utilisée en programmation VBA. Elle dispose pourtant de méthodes pour manipuler les données, préalablement chargées sous forme d’une liste (d’où son nom) qui simplifient la tâche du programmeur. Pour ne citer que les plus utiles :

- « Sort » trie la liste ;

- « Reverse » inverse l’ordre de la liste ;

- « Contains » indique si un élément est présent dans la liste ;

- « Item » renvoie ou modifie le contenu d’un élément de la liste ;

- « IndexOf » renvoie la position d’un élément dans la liste ;

- « Clone » fait une copie de la liste.

Les données étant en mémoire, les traitements peuvent dépasser la limite des 1 048 576 lignes d'une feuille Excel.
Vous trouverez sur Internet des documentations sur la collection « ArrayList », comme celle-ci que je vous recommande pour débuter : VBA ArrayList – A Complete Guide.

Le seul hic est, qu’en principe, une collection « ArrayList » n’a qu’une dimension, c’est-à-dire que la liste ne comporte qu’une seule colonne. Ce qui en restreint l’usage à des cas simples. Certainement la raison pour laquelle cette collection est si peu utilisée.

Mais, en trichant un peu, une collection « ArrayList » peut avoir plusieurs dimensions, tel un tableau d’Excel qui a plusieurs colonnes.
Malheureusement dans ce cas certaines des méthodes les plus intéressantes (« Sort », « Contains », « IndexOf », etc.) ne sont plus disponibles...
Il m’a donc fallu écrire en VBA des fonctions équivalentes afin de profiter de la rapidité de traitement de cette collection sur des listes de grande taille à plusieurs colonnes.

À l’appui d’un exercice simple, nous allons étudier dans les lignes qui suivent comment charger des données dans une liste à plusieurs dimensions, les manipuler à notre guise puis les restituer dans un tableau structuré.

II - Gérer une collection ArrayList à plusieurs dimensions

Avant de commencer notre étude, rappelons que pour utiliser une collection « ArrayList » il faut préalablement initialiser un objet de cette façon :
Dim List As Object
Set List = CreateObject("System.Collections.ArrayList")

Normalement la liste n’a qu’une dimension comme dans cet exemple où l’on y ajoute deux éléments :
List.Add "Apple"
List.Add "Pear"
Cet objet est en base 0 (et ne comporte pas d'en-tête), c’est-à-dire que le premier élément a l’indice 0.
Pour connaitre la valeur du premier élément : MaValeur = List.Item(0)
Notez que la liste est dynamique : lors de l’ajout ou de la suppression d’un élément sa taille est automatiquement ajustée.
Et que les données sont de types Variant, c'est-à-dire qu'elles peuvent être des chaînes de caractères, des nombres, des dates.

L’astuce pour avoir plusieurs dimensions est d’ajouter à la liste non pas une valeur classique mais un Array, par exemple :
List.Add Array("Apple", 10, "Red")
List.Add Array("Pear", 33, "Green")
Les dimensions sont elles aussi en base 0. Elles peuvent avoir des variables de types différents.
J’utiliserai souvent le mot « colonne » au lieu de « dimension », en référence aux tableaux d’Excel.
Donc pour connaitre la valeur de la première colonne du premier élément : MaValeur = List.Item(0)(0)
Ou, si « i » est l’élément et « j » la colonne : MaValeur = List.Item(i)(j)
Pour éviter toute confusion, les arguments de mes fonctions nécessitant un type Array seront préfixées « Array ».

Remarque : Dans une liste à plusieurs dimensions (plusieurs colonnes) vous ne pouvez pas modifier directement une valeur par List.Item(i)(j) = "x"
Il faut procéder en trois étapes :
- Mémoriser dans une variable (de type Variant) les données de toutes les dimensions de l'élément : v = List.Item(i)
- Modifier la dimension souhaitée : v(j) = "x" (où « j » est la dimension en base 0 à modifier)
- Recopier la variable (qui contient toutes les données des dimensions) dans l'élément : List.Item(i) = v

II-A - Exercice pour mieux comprendre les fonctions utilisées

Prenons un cas d’école.
Les notes des élèves sont contenues dans trois tableaux différents.
Le premier est un tableau structuré nommé « Tableau1 », les deux suivants sont des plages classiques sur les feuilles « Feuil5 » et « Feuil6 » :

Le tableau structuré nommé Tableau1

La plage de données sur la feuille Feuil5

La plage de données sur la feuille Feuil6

Le but est d’avoir un tableau de synthèse qui reprend la liste des élèves, le nombre de notes obtenues et leur moyenne. À chaque sélection d’un élève le détail de ses notes s’affiche dans un second tableau à gauche :

La restitution souhaitée

Gardez bien en mémoire ces tableaux car ils serviront de fil conducteur dans cette documentation.

II-B - ListFromRange - Charger des données

Pour commencer notre exercice nous allons charger dans un objet « ArrayList » les données de ces trois tableaux source avec la fonction ListFromRange.

Ses arguments sont :

- Rg : La plage qui contient les données, c’est-à-dire soit un tableau structuré, soit une plage classique qui possède ou non une ligne d’en-tête ;

- ArrayColumns : (facultatif) Un Array qui contient la liste des colonnes à reprendre (dans l’ordre indiqué) ou vide pour toutes les reprendre.

La fonction renvoie un objet « ArrayList ».

Pour charger le premier tableau, dans l’objet « L_Données » préalablement déclaré, nous indiquerons à la fonction de ne reprendre que les cinq premières colonnes (la colonne « Id » n’est pas souhaitée) :
Set L_Données = ListFromRange(Range("Tableau1"), Array(0, 1, 2, 3, 4))
Notez qu’il n’est pas nécessaire d’indiquer la feuille où se trouve le tableau structuré car Excel la retrouve de lui-même.
Et que Range("Tableau1") peut être remplacé par [Tableau1], tout dépend de vos habitudes de programmation.

Le deuxième tableau est chargé dans un autre objet, déclaré « L_Tps », que l’on concatènera à « L_Données » par la suite. Ce tableau n’ayant pas d’en-tête on indiquera dans l’argument « Rg » la cellule « A1 » car la fonction étendra automatiquement la plage à la région concernée. Par contre il faudra bien tenir compte de l’ordre des colonnes à reprendre :
Set L_Tps = ListFromRange(Sheets("Feuil5").Range("A1"), Array(0, 1, 2, 4, 3))

Enfin pour le troisième tableau à charger, l’argument « ArrayColumns » n’a pas besoin d’être renseigné puisque les colonnes sont dans l’ordre attendu. Il faut juste penser à indiquer dans l’argument « Rg » la cellule « A2 » pour ne pas reprendre la ligne d’en-tête et non pas « A1 » :
Set L_Tps = ListFromRange(Sheets("Feuil6").Range("A2"))

Astuce : La fonction ListFromCSV importe dans une liste un fichier texte « csv » (Comma-separated values) au format anglo-saxon, c'est-à-dire, les champs sont délimités par une virgule ; les dates sont au format année, mois, jour ; le séparateur numérique est un point.
Rassurez-vous, la fonction remet le tout au format français.
Inversement vous pouvez enregistrer une liste dans ce format avec la fonction ListToCSV.

II-C - ListAddList - Concaténer deux listes

Revenons à l’étape où nous avons chargé le premier tableau dans l’objet « L_Données » et le deuxième dans l’objet « L_Tps ».
Pour ajouter les données de « L_Tps » à « L_Données » nous utilisons la fonction ListAddList.

Ses arguments sont :

- List : La liste qui sera alimentée ;

- ListAdd : La liste qu’il faut ajouter à « List » ;

- ArrayColumnCompareValue : (facultatif) Un Array qui indique le ou les couples « Colonne », « Comparateur », « Valeur » pour identifier les éléments à ajouter (l’opérateur de comparaison peut être « = », « <> », « > », « < », « >= », « <= », « ?* » commence par, « * » contient, « *? » termine par) ;

- MatchCase : (facultatif) Indique s’il faut tenir compte ou non de la casse (True par défaut).

Ce qui donne ceci pour ajouter toutes les données de « L_Tps » à « L_Données » :
Call ListAddList(L_Données, L_Tps)

Nous ferons de même avec le troisième tableau pour obtenir une liste « L_Données » qui contient l’ensemble des données des trois sources.

Les arguments facultatifs de cette fonction permettent de limiter la concaténation à certaines données, par exemple quand les notes (colonne 2) sont supérieures à 0, soit :
Call ListAddList(L_Données, L_Tps, Array(2, ">", 0))

Notez que les deux objets doivent avoir la même structure de données, c’est-à-dire le même nombre de colonnes.

Astuce : La ligne d'instruction Call ListAddList(L_Données, L_Tps, Array(2, ">", 0)) n'est pas évidente à comprendre car elle reprendre deux variables numériques dans sa partie Array(2, ">", 0) et l'on peut confondre l'argument colonne et l'argument valeur. C'est pourquoi je propose de préfixer l'argument qui représente la colonne par "C", ce qui donne Call ListAddList(L_Données, L_Tps, Array("C2", ">", 0)) et peut se lire plus facilement par : Colonne 2 est supérieure à 0.
Je vais utiliser cette notation, qui est facultative, dans la suite de cette documentation. Les fonctions sont adaptées pour gérer ces deux façons de faire, libre à vous d'utiliser ce qui vous convient le mieux.

- Les symboles que j'ai choisis pour identifier les opérateurs de comparaison commence par « ?* », contient « * », termine par « *? », peuvent être remplacés par ceux de votre choix dans la fonction VbCompare s'ils ne sont pas assez explicites pour vous.

- L'instruction Call ListAddList(L_Données, L_Tps) peut être remplacée par son équivalent : ListAddList L_Données, L_Tps
Tout dépend de vos habitudes de programmation.

II-D - ListRemove - Supprimer des éléments

Les données chargées dans l’objet « L_Données » inclues des notes à 0, qui signifient que l’évaluation n’a pas encore été faite. Il faut donc les supprimer pour ne pas fausser la moyenne, avec la fonction ListRemove.

Ses arguments sont :

- List : La liste qui contient les données ;

- ArrayColumnCompareValue : (facultatif) Un Array qui indique le ou les couples « Colonne », « Comparateur », « Valeur » pour identifier les éléments à supprimer (l’opérateur de comparaison peut être « = », « <> », « > », « < », « >= », « <= », « ?* » commence par, « * » contient, « *? » termine par) ;

- MatchCase : (facultatif) Indique s’il faut tenir compte ou non de la casse (True par défaut).

Et donc pour supprimer les notes qui valent 0 (c’est-à-dire la colonne 2 vaut 0) :
Call ListRemove(L_Données, Array("C2", "=", 0))

Astuce : Pour supprimer un élément d’après sa position, utilisez la méthode « RemoveAt » qui reste disponible pour une liste à plusieurs dimensions.
Par exemple pour supprimer le dernier élément de la liste « L_Données » :
L_Données.RemoveAt L_Données.Count – 1
Ou pour supprimer le premier élément :
L_Données.RemoveAt 0

II-E - ListSort - Trier les données

La fonction ListSort trie par ordre croissant un objet « ArrayList » sur une ou plusieurs de ses colonnes.

Ses arguments sont :

- List : La liste qui contient les données ;

- ArrayColumns : Les colonnes (en Array) sur lesquelles portent le tri ;

- MatchCase : (facultatif) Indique s’il faut tenir compte ou non de la casse (True par défaut).

Nous allons ainsi trier par ordre croissant l’objet « L_Données » sur les noms, prénoms et dates :
Call ListSort(L_Données, Array("C0", "C1", "C3"))
Cela sera nécessaire pour la restitution du détail lorsqu’un élève est sélectionné.

Astuce : Vous pouvez inverser l’ordre de la liste avec la méthode « Reverse » qui reste disponible pour une liste à plusieurs dimensions : L_Données.Reverse

II-F - ListFromList - Copier certaines colonnes d’une liste dans une autre liste

Pour générer la liste de synthèse des élèves, il nous faut dans un premier temps recopier les noms et prénoms de la liste « L_Données » dans une autre liste que nous nommerons « L_Synthese ».

Les arguments de la fonction ListFromList sont :

- List : La liste qui contient les données ;

- ArrayColumns : Les colonnes (en Array) qu’il faut reprendre et dans l’ordre désiré.

La fonction renvoie un objet « ArrayList ».

Ici nous copions les colonnes 0 et 1 de « L_Données » dans « L_Synthese »  :
Set L_Synthese = ListFromList(L_Données, Array("C0", "C1"))

Astuce : Pour copier toutes les données de « L_Données » dans « L_Synthese » nous pouvons utiliser la méthode « Clone » qui reste disponible pour une liste à plusieurs dimensions : Set L_Synthese = L_Données.Clone
À ne pas confondre avec Set L_Synthese = L_Données qui ne génère pas une nouvelle liste en mémoire mais juste un pointeur vers la liste « L_Données », et dans ce cas la modification d’un élément dans l’une des listes se répercute dans la seconde.

II-G - ListUnique - Générer une liste unique

Nous pouvons maintenant générer une liste sans doublon pour la synthèse des élèves à partir de la liste « L_Synthese » qui ne contient que deux colonnes, pour les noms et prénoms.
La fonction ListUnique réalise cela.

Ses arguments sont :

- List : La liste qui contient les données ;

- MatchCase : (facultatif) Indique s’il faut tenir compte ou non de la casse (True par défaut).

La liste « L_Synthese » est transformée en une liste unique, triée par ordre croissant :
Call ListUnique(L_Synthese)

II-H - ListAddcolumns - Ajouter ou supprimer des colonnes à une liste

Nous venons de voir que la liste « L_Synthese » des élèves (sans doublon) ne contient que deux colonnes, pour les noms et prénoms. Or il nous en faut deux autres : pour le nombre de notes et la moyenne.
Nous les ajoutons avec la fonction ListAddcolumns.

Ses arguments sont :

- List : La liste qui contient les données ;

- Columns : Le nombre de colonnes à ajouter, ou à supprimer si la valeur est négative ;

- Index : (facultatif) Si True alors indique la position de l'élément dans la dernière colonne (soit la création d'une indexation), la valeur par défaut est False (nous verrons un exemple d'utilisation de l'indexation par la suite).

Call ListAddcolumns(L_Synthese, 2)

II-I - ListCount - Compter le nombre d’éléments

Pour alimenter la colonne du nombre des notes de la liste « L_Synthese » nous allons faire une boucle sur ses élément (nous verrons plus loin comment faire cette boucle) et pour chacun d’entre eux compter le nombre d’éléments dans la liste « L_Données » qui correspondent au nom et prénom de l'élève.
La fonction ListCount renvoie le nombre d’éléments qui correspondent aux critères demandés.

Ses arguments sont :

- List : La liste qui contient les données ;

- ArrayColumnCompareValue : Un Array qui indique le ou les couples « Colonne », « Comparateur », « Valeur » pour identifier les éléments concernés (l’opérateur de comparaison peut être « = », « <> », « > », « < », « >= », « <= », « ?* » commence par, « * » contient, « *? » termine par) ;

- MatchCase : (facultatif) Indique s’il faut tenir compte ou non de la casse (True par défaut) ;

- Sorted : (facultatif) True si la liste est triée par ordre croissant et que l'on peut faire une recherche dichotomique sur le premier couple passé dans « ArrayColumnCompareValue », la valeur par défaut est False.

Soit pour chaque élément « i », il faut compter combien de fois l’on retrouve dans la liste « L_Données » en colonne 0 son nom, correspondant à « L_Synthese(i)(0) », et en colonne 1 son prénom, correspondant à « L_Synthese(i)(1) » :
Nb = ListCount(L_Données, Array("C0", "=", L_Synthese(i)(0), "C1", "=", L_Synthese(i)(1)), True, True)

Astuce : Dans notre cas la liste « L_Données » où porte la recherche est triée par ordre croissant sur les noms, prénoms et dates. Pour trouver plus rapidement les éléments recherchés dans cette liste, au lieu de tous les lire, il est bien plus rapide de faire une recherche dichotomique pour accéder rapidement au premier élément concerné et de commencer les analyses à partir de cette position. C’est pourquoi ici l’argument « Sorted » est mis à True.
Pour faire des recherches en boucle sur de grandes listes, je vous recommande de trier au préalable la liste source et de procéder ainsi, car vous gagnerez énormément en temps de traitement.

II-J - ListSum - Faire la somme d’une colonne

Nous allons procéder de la même façon pour alimenter la colonne de la moyenne des notes, qui est le nombre de notes divisé par la somme des notes.
Nous avons déjà le nombre de notes, nous allons retrouver la somme des notes avec la fonction ListSum.

Ses arguments sont :

- List : La liste qui contient les données ;

- Column : La colonne dont il faut faire la somme ;

- ArrayColumnCompareValue : Un Array qui indique le ou les couples « Colonne », « Comparateur », « Valeur » pour identifier les éléments concernés (l’opérateur de comparaison peut être « = », « <> », « > », « < », « >= », « <= », « ?* » commence par, « * » contient, « *? » termine par) ;

- MatchCase : (facultatif) Indique s’il faut tenir compte ou non de la casse (True par défaut) ;

- Sorted : (facultatif) True si la liste est triée par ordre croissant et que l'on peut faire une recherche dichotomique sur le premier couple passé dans « ArrayColumnCompareValue », la valeur par défaut est False.

Soit pour chaque élément « i », sachant que les noms sont en colonne 0 et les prénoms en colonne 1 dans les deux listes, et que les notes sont en colonne 2 dans « L_Données » :
Somme = ListSum(L_Données, "C2", Array("C0", "=", L_Synthese(i)(0), "C1", "=", L_Synthese(i)(1)), True, True)

II-K - ListUpdateItem - Mettre à jour les données

Nous avons déterminé pour chaque élève le nombre de notes et leur somme. Il ne reste plus qu’à mettre à jour les colonnes « Nb » et « Moyenne », colonnes 2 et 3, de l’objet « L_Synthese », avec la fonction ListUpdateItem.

Ses arguments sont :

- List : La liste qui contient les données à mettre à jour ;

- Column : La colonne qu'il faut modifier ;

- Action : L’action à effectuer
« = » remplacer la donnée par la valeur de l'argument "Value",
« + » ajouter à la donnée la valeur de l'argument "Value",
« - » soustraire à la donnée la valeur de l'argument "Value",
« * » multiplier la donnée par la valeur de l'argument "Value",
« / » diviser la donnée par la valeur de l'argument "Value" ;

- Value : La valeur de référence pour modifier la colonne suivant l'action désirée ;

- Item : La position de l’élément à mettre à jour.

Soit pour chaque élément « i », pour remplacer la note en colonne 2 dans « L_Synthese » par la valeur « Nb » retrouvée :
Call ListUpdateItem(L_Synthese, "C2", "=", Nb, i)
Et pour remplacer la moyenne en colonne 3 (avec une précision d’un chiffre après la virgule) :
Call ListUpdateItem(L_Synthese, "C3", "=", Round(Somme / Nb, 1), i)

Remarque : Pour mettre à jour chaque élément nous faisons une boucle :
For i = 0 To L_Synthese.Count – 1 (où « i » est déclaré Long).
Il n’est pas possible d’utiliser For Each Element In List (où « Element » est déclaré Variant) car dans notre cas nous avons besoin de connaitre la position « i » de l’élément pour sa mise à jour. Position qui renseigne l’argument « Item ».

Astuce : La fonction ListUpdateAll met à jour tout une liste suivant un critère, sans avoir besoin de faire une boucle.
En plus des quatre premiers arguments de ListUpdateItem cette fonction en comporte deux autres déjà présentés plusieurs fois : « ArrayColumnCompareValue » et « MatchCase ».
Par exemple pour ajouter 1 point aux notes inférieures à 10 dans la liste « L_Données » :
Call ListUpdateAll(L_Données, "C2", "+", 1, Array("C2", "<", 10))

II-L - ListToTable – Alimenter un tableau structuré

Nous avons terminé tous nos traitements, il ne reste plus qu’à alimenter le tableau structuré de synthèse par élève, nommé « TS_Synthese », avec les données de la liste « L_Synthese ».

La fonction ListToTable a les arguments suivants :

- List : La liste qui contient les données ;

- Action : L’action à effectuer
« = » remplacer les données existantes du tableau structuré par celles de la liste,
« + » ajouter à la suite du tableau structuré les données de la liste ;

- TS : Le tableau structuré à renseigner.

Call ListToTable(L_Synthese, "=", [TS_Synthese])

II-M - ListIndexOf - Connaitre la position d’un élément

Pour connaitre la moyenne de l’élève « TERRIEUR Alain » il nous faut avant tout connaitre sa position dans la liste « L_Synthese ».

Pour cela nous utiliserons la fonction ListIndexOf, ses arguments sont :

- List : La liste qui contient les données ;

- ArrayColumnCompareValue : Un Array qui indique le ou les couples « Colonne », « Comparateur », « Valeur » pour identifier les éléments concernés (l’opérateur de comparaison peut être « = », « <> », « > », « < », « >= », « <= », « ?* » commence par, « * » contient, « *? » termine par) ;

- MatchCase : (facultatif) Indique s’il faut tenir compte ou non de la casse (True par défaut) ;

- Sorted : (facultatif) True si la liste est triée par ordre croissant et que l'on peut faire une recherche dichotomique sur le premier couple passé dans « ArrayColumnCompareValue », la valeur par défaut est False.

La fonction renvoie la position du premier élément trouvé dans la liste qui répond aux critères de sélection, ou -1 si rien n’est trouvé.

Dans notre cas on obtient la position par :
i = ListIndexOf(L_Synthese, Array("C0", "=", "TERRIEUR", "C1", "=", "Alain"))
Puis la moyenne par :
Moyenne = L_Synthese.Item(i)(3)

II-N - ListContains - Savoir si un élément existe

Cette fois nous souhaitons juste savoir si au moins un élève a une moyenne supérieure ou égale à 15.

Pour cela nous utiliserons la fonction ListContains, ses arguments sont :

- List : La liste qui contient les données ;

- ArrayColumnCompareValue : Un Array qui indique le ou les couples « Colonne », « Comparateur », « Valeur » pour identifier les éléments concernés (l’opérateur de comparaison peut être « = », « <> », « > », « < », « >= », « <= », « ?* » commence par, « * » contient, « *? » termine par) ;

- MatchCase : (facultatif) Indique s’il faut tenir compte ou non de la casse (True par défaut) ;

- Sorted : (facultatif) True si la liste est triée par ordre croissant et que l'on peut faire une recherche dichotomique sur le premier couple passé dans « ArrayColumnCompareValue », la valeur par défaut est False.

La fonction renvoie True si un élément répond aux critères de sélection, ou False si rien n’est trouvé.

Dans notre cas ListContains(L_Synthese, Array("C3", ">=", 15)) renvoie True.

II-O - ListAddItem - Ajouter un élément

Un nouvel élève vient d’arriver. N’ayant pas encore été noté il n’apparait donc pas dans les listes, mais nous souhaitons le voir dans la synthèse en dernière ligne.
Nous allons l’ajouter « manuellement » avec la fonction ListAddItem.

Ses arguments sont :

- List : La liste qui contient les données ;

- ArrayValues : Un Array des valeurs à ajouter (dans l'ordre des colonnes de l'objet) ;

- Index : (facultatif) Indique la position où insérer le nouvel élément, vide ou -1 pour l’ajouter à la suite de la liste.

Par exemple :
Call ListAddItem(L_Synthese, Array("AIMAR", "Jean", Null, Null))

Remarque : Toutes les dimensions doivent être renseignées, d’où ici l’usage des Null pour que les colonnes prennent la valeur « vide ».

III - Le code source de l’exercice

Voici le code intégral de l’exercice :

Public L_Données As Object

'----------------------------------------------------------------------------------------
Sub Exemple()
'----------------------------------------------------------------------------------------
Dim i As Long
Dim L_Tps As Object, L_Synthese As Object
Dim Nb As Long, Somme As Double

' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Charge les données à importer depuis un tableau structuré nommé "Tableau1"
' (pas besoin d'indiquer la feuille car Excel la retrouve de lui-même, mais
' comme il y a une colonne de trop il faut indiquer les colonnes à reprendre),
' et mémorise les données dans "L_Données" (qui est publique car on s'en servira
' pas la suite lors d'un événement sur le tableau de synthèse):
Set L_Données = ListFromRange(Range("Tableau1"), Array("C0", "C1", "C2", "C3", "C4"))
' Charge les données à importer d'une autre liste sans en-tête
' (et dans un ordre différent que celui que l'on souhaite):
Set L_Tps = ListFromRange(Sheets("Feuil5").Range("A1"), Array("C0", "C1", "C2", "C4", "C3"))
' Concatène les deux listes dans l'objet "L_Données":
Call ListAddList(L_Données, L_Tps)
' Charge les données à importer d'une autre liste avec en-têtes (pas besoin d'indiquer
' l'ordre des colonnes car elles sont dans le bon ordre et il n'y en a pas en trop):
Set L_Tps = ListFromRange(Sheets("Feuil6").Range("A2"))
' Concatène les deux listes dans l'objet "L_Données":
Call ListAddList(L_Données, L_Tps)

' Supprime les notes à 0 (càd 0 est dans l'indice 2):
Call ListRemove(L_Données, Array("C2", "=", 0), True)

' Trie la liste par nom, prénom, date:
Call ListSort(L_Données, Array("C0", "C1", "C3"), True)

' Charge uniquement les noms et prénoms (pour alimenter la synthèse):
Set L_Synthese = ListFromList(L_Données, Array("C0", "C1"))

' Création d'une liste unique avec les noms et prénoms (triée dans l'ordre de ses colonnes):
Call ListUnique(L_Synthese, True)

' Ajoute deux colonnes (pour contenir par la suite le nombre de notes et la moyenne)
' à cette liste qui servira de synthèse:
Call ListAddcolumns(L_Synthese, 2)

' Boucle sur les éléments de L_Synthese (qui est la synthèse) en base 0:
Application.DisplayStatusBar = True
For i = 0 To L_Synthese.Count - 1
' Affiche la progression de la mise à jour:
If L_Synthese.Count > 100 Then
If i Mod L_Synthese.Count / 100 = 0 Then Application.StatusBar = "Mise à jour : " & Format(i / L_Synthese.Count, "0%")
End If
' Recherche le nombre de notes pour le nom + prénom dans la liste source triée:
Nb = ListCount(L_Données, Array("C0", "=", L_Synthese(i)(0), "C1", "=", L_Synthese(i)(1)), True, True)
' Mise à jour de la colonne Nb (2 en base 0) pour l'élément i dans la liste de synthèse:
Call ListUpdateItem(L_Synthese, "C2", "=", Nb, i)
' Recherche la somme des notes pour le nom + prénom dans la liste source triée:
Somme = ListSum(L_Données, "C2", Array("C0", "=", L_Synthese(i)(0), "C1", "=", L_Synthese(i)(1)), True, True)
' Mise à jour de la colonne Moyenne (3 en base 0) pour l'élément i dans la liste de synthèse:
Call ListUpdateItem(L_Synthese, "C3", "=", Round(Somme / Nb, 1), i)
Next i
Application.StatusBar = ""

' Affiche la synthèse en remplaçant les données existantes:
' [TS_Synthese] est équivalent à Range("TS_Synthese"):
Call ListToTable(L_Synthese, "=", [TS_Synthese])

' Prépare le tableau de détail:
With Range("TS_Données").ListObject
.DataBodyRange.Clear
If .ListRows.Count > 1 Then .DataBodyRange.Rows(2 & ":" & .ListRows.Count).Delete
.ShowHeaders = True
.ShowTotals = False
End With
[A12].Select

' Fin du traitement:
Gest_Err:
If Err.Number <> 0 Then
MsgBox "Erreur " & Err.Number & " : " & Err.Description, vbCritical, Err.Source
End If
Err.Clear

End Sub
'------------------------------------------------------------------------------------------------

Et le code sur la feuille où se trouve le tableau de synthèse pour gérer l’évènement sur sélection d’un élève :

'------------------------------------------------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'------------------------------------------------------------------------------------------------
' Si la cellule (active) est dans un tableau structuré:
If Not Target.ListObject Is Nothing Then

' Pointe sur ce tableau:
Dim TS As Range
Set TS = Range(Target.ListObject)

' Si ce n'est pas une ligne de titre et le tableau de synthèse:
If Target.Row >= TS.Row And TS.ListObject.Name = "TS_Synthese" Then
' Retrouve la ligne dans le tableau structuré:
Dim i As Long, Nom As String, Prénom As String
i = Target.Row - TS.Row + 1
' Et le nom et prénom concernés:
Nom = TS.ListObject.DataBodyRange(i, 1)
Prénom = TS.ListObject.DataBodyRange(i, 2)
' Création d'une liste qui contient les données de l'élément cliqué:
If Not L_Données Is Nothing Then
Dim List As Object
Set List = CreateObject("System.Collections.ArrayList")
Call ListAddList(List, L_Données, Array("C0", "=", Nom, "C1", "=", Prénom))
' Affiche la liste dans le tableau structuré TS_Données:
If List.Count > 0 Then Call ListToTable(List, "=", [TS_Données])
End If
End If

End If

End Sub
'------------------------------------------------------------------------------------------------

IV - ListFromSQL - Exécuter une requête SQL sur une liste

Le tableau de synthèse des notes et moyennes des élèves que nous avons obtenu ferait un bon exercice de requête SQL :
« Sélectionner dans la liste « L_Données » les champs [Nom Famille], [Prénom], Nombre de ([Note]), Moyenne de ([Note]) ; Regrouper par [Nom Famille], [Prénom] ; Trier par [Nom Famille], [Prénom] ».

Mais il n’est pas possible d’exécuter une requête SQL sur un objet « ArrayList ».
Sauf si l’on triche un peu...
Il suffit de reverser les données de la liste sur une feuille de calcul provisoire, d’y ajouter une ligne d’en-tête de colonne (nommés arbitrairement C0, C1, C2, etc.), d’exécuter une requête SQL, de récupérer le jeu d’enregistrements obtenu pour le placer dans une nouvelle liste, et enfin de supprimer la feuille provisoire.

La fonction ListFRomSQL a les arguments suivants :

- List : La liste qui contient les données ;

- Fields : Les champs à sélectionner ;

- StrSQL : L’instruction en SQL.

La fonction renvoie un objet « ArrayList » qui contient le jeu d’enregistrements obtenu.

Ce qui permet d’obtenir le tableau de synthèse en une seule instruction et avec de bien meilleurs temps de traitement, sur les grandes listes, qu’avec la boucle que nous avons faite sur chaque élément :
Set L_Synthese = ListFromSQL(L_Données, "C0, C1, Count(C2), AVG(C2)", "GROUP BY C0, C1 ORDER BY C0, C1")

Les habitués du SQL remarqueront que la commande « SELECT » n’est pas indiquée : Elle est ajoutée automatiquement avant la liste des champs.
Tout comme il manque la commande « FROM » : C’est parce qu’elle doit être complétée du nom de la feuille créée temporairement, nom que l’on ne connait qu’à sa création.

Remarques sur l’argument « Fields » :

L’argument « Fields » indique les numéros des colonnes à sélectionner, en base 0 et préfixés par « C », qui correspondent donc à la dimension de la liste, elle aussi en base 0.
La première colonne est désignée « C0 », la suivante « C1 » et ainsi de suite.
Une étoile « * » permet de sélectionner directement toutes les colonnes, ce qui risque d’augmenter les temps de traitement sur de grandes listes.
Vous pouvez inclure des fonctions d’agrégation :
- AVG : Calcule la moyenne ;
- SUM : Calcule la somme ;
- COUNT : Compte le nombre d'éléments ;
- MIM : Renvoie la valeur la plus petite ;
- MAX : Renvoie la valeur la plus grande.

Remarques sur l’argument « StrSQL » :

L’argument « StrSQL » indique les instructions de la requête. Plusieurs commandes sont disponibles, les principales sont :

- GROUPE BY : Fait un regroupement des données.

- ORDER BY : Trie les colonnes par ordre ascendant (par défaut) avec la clause ASC ou descendant avec la clause DESC. Il est possible d'ordonner sur plusieurs colonnes en respectant la syntaxe :
ORDER BY « colonne 1 » [ASC, DESC], « colonne 2 » [ASC, DESC]

- WHERE : Pour restreindre la sélection vous pouvez ajouter une condition simple ou combinée avec les opérateurs AND et OR, comme en VBA.
Les données alphanumériques sont à mettre entre simples quotes. Si la donnée comporte un simple quote il convient de le doubler. Par exemple :
WHERE « colonne » = 'Val d''Oise'
Les dates sont à mettre entre deux croisillons et au format anglo-saxon (année/mois/jour). Par exemple pour sélectionner les personnes nées à Noël 1971 :
WHERE « colonne » = #1971/12/25#
Le mot clé IN permet de sélectionner des éléments parmi une liste de valeurs, soit la syntaxe suivante :
WHERE « colonne » IN ('valeur1', 'valeur2', 'valeur3'…)
Le mot clé LIKE permet de sélectionner des chaînes de caractères en disposant des jokers :
WHERE « colonne » LIKE 'T%' renvoie les noms commençants par « T ».
WHERE « colonne » LIKE '%TOTO%' renvoie les noms qui contiennent « TOTO ».

Vous trouverez sur Internet d'autres informations sur les requêtes SQL.
J'aime bien cette adresse : http://www.1keydata.com/fr/sql/syntaxe-sql.php.
Attention, toutes les commandes SQL ne sont pas compatibles avec EXCEL.

La fonction ListFRomSQL utilise des liaisons tardives, vous n’avez donc pas besoin d’installer la bibliothèque « Microsoft ActiveX Data Objects 6.0 Library » dans votre projet.

Un autre exemple :
Reprenons notre cas où la liste « L_Données » contient les données de trois tableaux fusionnés et « L_Synthese » la liste de synthèse.
On souhaite ajouter 2 points aux notes inférieures à 10, sans dépasser 10, uniquement pour les élèves dont la moyenne est inférieure à 10.

Nous souhaitons augmenter les notes inférieures à 10 de 2 points, sans dépasser 10, des élèves dont la moyenne est inférieure à 10

Voici comment nous allons procéder :
- Ajouter une colonne à « L_Données » qui contiendra l'indexation des éléments (vous allez comprendre pourquoi ci-dessous).
- Boucler sur les éléments de la liste « L_Synthese » et si la moyenne (colonne 3) est inférieure à 10 alors :
- Faire une requête SQL pour récupérer dans une liste temporaire les notes inférieures à 10 de l'élève identifié par son nom (colonne 0) et son prénom (colonne 1).
- Pour chaque élément de la liste obtenue :
- Récupérer l'indexation de l'évaluation contenue dans la colonne 5.
- Ajouter 2 points à la note (colonne 2) dans la limite de 10.
- Mettre à jour l'élément dans « L_Données » puisque l'on connait sa position (par l'indexation).
- Supprimer la colonne d'indexation dans « L_Données » qui n'est plus utile.
- Actualiser le tableau de synthèse par la requête SQL que nous connaissons.
- Afficher la synthèse dans le tableau structuré.

Ce qui donne :

' Ajoute une indexation à la liste L_Données
Call ListAddcolumns(L_Données, 1, True)

' Boucle sur chaque élément de la liste L_Synthese:
For Each E In L_Synthese
' Si la moyenne est < 10:
If E(3) < 10 Then
' Requête SQL pour obtenir les notes < 10 de l'élève:
Set Rt = ListFromSQL(L_Données, "*", "WHERE C2<10 AND C0='" & E(0) & "' AND C1='" & E(1) & "'")
' Boucle sur chaque note:
For Each K In Rt
' Récupère l'indexe de l'évaluation:
i = K(5)
' Ajouter 2 points à la note sans dépasser 10:
Note = K(2) + 2
If Note > 10 Then Note = 10
' Mise à jour de l'élément dans la liste L_Données
Call ListUpdateItem(L_Données, "C2", "=", Note, i)
Next K
End If
Next E

' Supprime de la liste L_Données l'indexation:
Call ListAddcolumns(L_Données, -1)
' Actualise le tableau de synthèse:
Set L_Synthese = ListFromSQL(L_Données, "C0, C1, Count(C2), AVG(C2)", "GROUP BY C0, C1 ORDER BY C0, C1")
' Et l'affiche:
Call ListToTable(L_Synthese, "=", [TS_Synthese])

Un dernier exemple pour vous convaincre de l'utilité des requêtes SQL :

Á partir de cette liste, je souhaite une synthèse des 5 départements qui ont le plus de communes.

Extrait de la liste des données du tableau structuré TS_CP

La synthèse restituée dans le tableau structuré TS_Synthese par la requête SQL

Dim List As Object
Dim Rt As Object

Set List = ListFromRange([TS_CP])
Set Rt = ListFromSQL(List, "TOP 5 C4, C6, C3, Count(C4)", "WHERE C4>'' GROUP BY C4, C3, C6 ORDER BY Count(C4) DESC")
Call ListToTable(Rt, "=", [TS_Synthese])

V - Conclusion

L’exercice purement théorique repris dans cette documentation donne une idée de ce qu’il est possible de faire pour gérer des données à plusieurs dimensions en utilisant la collection « ArrayList ».

Je suis bien conscient que vous obtenez le même résultat avec d’autres techniques de programmation (ou avec certaines formules d’Excel) et que je ne vous présente rien de révolutionnaire. Mon souhait est juste de vous faire découvrir une autre approche, avec ses avantages et ses inconvénients.

Toutefois, si le sujet vous intéresse, vous trouverez dans le fichier joint le module « ArrayList » qui contient les fonctions étudiées. Vous pouvez vous en inspirer pour les améliorer, les compléter, en écrire de nouvelles : n’hésitez pas à nous en faire profiter dans cette discussion.

Et pour plus d’informations sur les tableaux structurés je vous invite à consulter cette documentation : Fonctions en VBA pour gérer les Tableaux Structurés d’Excel.

Bonne programmation.
Laurent OTT.
2024.

VI - Remerciements

Je remercie User, gaby277 et Valérie LEVY pour leur relecture, leurs apports et leurs conseils.
Ainsi que toute l’équipe de Developpez.com qui participe à la maintenance du site.

VII - Le fichier joint

Le fichier ArrayList.xlsm contient les fonctions présentées ici dans le module « ArrayList ».

VIII - Le code des fonctions pour ceux qui ne peuvent pas télécharger le fichier joint

Cliquez sur « Afficher le code » pour voir le code des fonctions

Option Explicit

'----------------------------------------------------------------------------------------
Public Function ListFromRange(Rg As Range, Optional ByVal ArrayColumns As Variant = "") As Object
'----------------------------------------------------------------------------------------
' Charge les données (en valeur) d'une plage de données ou d'un Tableau Structuré, en
' reprenant, au choix, toutes les colonnes ou une partie, et renvoie un objet ArrayList.
'----------------------------------------------------------------------------------------
' Rg : Soit un tableau structuré, soit une plage. Dans ce cas, si la plage contient une
'      ligne d'en-tête alors ne pas renseigner cette ligne mais la ligne suivante, par
'      exemple : Set List = ListFromRange(Range("A2"))
' ArrayColumns : Liste des colonnes (en Array et en base 0) à reprendre et dans l'ordre de
'                reprise, ou vide pour reprendre toutes les colonnes dans leur ordre d'origine.
'----------------------------------------------------------------------------------------
' Renvoie : Un objet ArrayList qui contient les données chargées.
'----------------------------------------------------------------------------------------
Dim i As Long, k As Integer, z As Byte
Dim NbColonne As Integer
Dim Data As Variant
Dim Colonne As Variant

' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Création d'un objet ArrayList qui contiendra les données chargées:
Dim List As Object
Set List = CreateObject("System.Collections.ArrayList")

' Si la plage source est un tableau structuré:
If Not Rg.ListObject Is Nothing Then
Data = Rg.ListObject.DataBodyRange.Value
Else ' Sinon c'est une plage classique:
Data = Rg.Value
' Si une seule cellule est indiquée alors étendre la plage à la région:
If Rg.Count = 1 Then Data = Rg.CurrentRegion
' Ne pas prendre l'en-tête:
If Rg.CurrentRegion.Row < Rg.Row Then z = 1
End If

' Si aucune données:
On Error Resume Next
i = -1
i = UBound(Data)
On Error GoTo Gest_Err
If i = -1 Then GoTo Gest_Err

' Liste des colonnes à reprendre:
If IsArray(ArrayColumns) = False Then ArrayColumns = Array(ArrayColumns)
' S'il faut tout reprendre:
If ArrayColumns(0) = "" Then
NbColonne = UBound(Data, 2) - 1
ReDim Colonne(0 To NbColonne)
For i = 0 To NbColonne: Colonne(i) = i: Next i
Else ' S'il faut respecter la limitation indiquée:
NbColonne = UBound(ArrayColumns)
ReDim Colonne(0 To NbColonne)
For i = 0 To NbColonne
Colonne(i) = VbValue(ArrayColumns(i))
Next i
End If

' Dimensionne une mémoire pour reprendre les données d'une ligne:
ReDim V(0 To NbColonne)

' Boucle sur les lignes:
For i = 1 + z To UBound(Data)
' Boucle sur les colonnes à reprendre:
For k = 0 To NbColonne
V(k) = Data(i, Colonne(k) + 1)
Next k
' Ajoute la ligne à l'objet ArrayList:
List.Add V
Next i

' Renvoie l'objet ArrayList avec les données chargées:
Set ListFromRange = List

' Fin du traitement:
Gest_Err:
If Err.Number <> 0 Then
Err.Raise Err.Number, "ListFromRange", Err.Description
End If
Err.Clear

End Function

'----------------------------------------------------------------------------------------
Public Function ListFromList(List As Object, Optional ByVal ArrayColumns As Variant = "") As Object
'----------------------------------------------------------------------------------------
' Charge les données d'un objet ArrayList, en reprenant toutes ses colonnes ou une partie,
' et renvoie un autre objet ArrayList.
'----------------------------------------------------------------------------------------
' List : L'objet ArrayList qui contient les données
' ArrayColumns : Liste des colonnes (en Array et en base 0) à reprendre et dans l'ordre de reprise,
'                ou vide pour reprendre toutes les colonnes dans leur ordre d'origine.
'----------------------------------------------------------------------------------------
' Renvoie : Un objet ArrayList qui contient les données chargées.
'----------------------------------------------------------------------------------------
Dim i As Variant, k As Integer, z As Byte
Dim NbColonne As Integer
Dim Colonne As Variant

' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Création d'un objet ArrayList qui contiendra les données chargées:
Dim ListTps As Object
Set ListTps = CreateObject("System.Collections.ArrayList")

' Liste des colonnes à reprendre:
If IsArray(ArrayColumns) = False Then ArrayColumns = Array(ArrayColumns)
' S'il faut tout reprendre alors clone la liste:
If ArrayColumns(0) = "" Then
Set ListFromList = List.Clone
GoTo Gest_Err
Else ' S'il faut respecter la limitation indiquée:
NbColonne = UBound(ArrayColumns)
ReDim Colonne(0 To NbColonne)
For i = 0 To NbColonne
Colonne(i) = VbValue(ArrayColumns(i))
Next i
End If

' Dimensionne une mémoire pour reprendre les données d'une ligne:
ReDim V(0 To NbColonne)

' Boucle sur les éléments:
For Each i In List
' Boucle sur les colonnes à reprendre:
For k = 0 To NbColonne
V(k) = i(k)
Next k
' Ajoute la ligne à l'objet:
ListTps.Add V
Next i

' Renvoie l'objet ArrayList avec les données chargées:
Set ListFromList = ListTps

' Fin du traitement:
Gest_Err:
If Err.Number <> 0 Then
Err.Raise Err.Number, "ListFromList", Err.Description
End If
Err.Clear

End Function

'------------------------------------------------------------------------------------------------
Public Function ListFromSQL(List As Object, Fields As String, ByVal StrSQL As String) As Object
'------------------------------------------------------------------------------------------------
' Exécute une requête SQL sur un objet ArrayList à plusieurs dimensions.
'------------------------------------------------------------------------------------------------
' List : L'objet ArrayList qui contient les données
' Fields : Les champs de la liste à sélectionner (référencés de C0 à Cn), ou "*" pour tout prendre.
' StrSQL : La requête SQL.
'------------------------------------------------------------------------------------------------
' Renvoie : Une liste qui répond à la requête SQL, ou Nothing.
'------------------------------------------------------------------------------------------------
' Exemple d'appel:
' Set Rt = ListFromSQL(List, "C0, C1, Sum(C2)/Count(C2)", "WHERE C2>0 GROUP BY C0, C1 ORDER BY C0, C1")
'------------------------------------------------------------------------------------------------
Dim Cnn As Variant  ' Liaison anticipée => As ADODB.Connection
Dim Rs As Variant   ' Liaison anticipée => As ADODB.Recordset
Dim j As Integer
Dim Anc_EnableEvents As Boolean
Dim Anc_ScreenUpdating As Boolean

' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear
Set ListFromSQL = Nothing

' Ajoute une feuille:
Anc_EnableEvents = Application.EnableEvents
Anc_ScreenUpdating = Application.ScreenUpdating
Application.EnableEvents = False
Application.ScreenUpdating = False
Sheets.Add

' Ajoute les colonnes d'en-tête:
For j = 0 To UBound(List.Item(0))
Cells(1, j + 1) = "C" & j
Next j

' Mémorise les données de la liste (List.ToArray bugue sur les dates):
ReDim Mémoire(1 To List.Count, 1 To UBound(List.Item(0)) + 1)
Dim Ligne As Long, Colonne As Integer
For Ligne = 1 To List.Count
For Colonne = 1 To UBound(List.Item(0)) + 1
Mémoire(Ligne, Colonne) = List.Item(Ligne - 1)(Colonne - 1)
Next Colonne
Next Ligne

' Affiche les données:
Range("A2").Resize(List.Count, UBound(List.Item(0)) + 1).Value = Mémoire

' Création d'une connexion:
Set Cnn = CreateObject("ADODB.Connection") ' Liaison anticipée => Set Cnn = New ADODB.Connection
Cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ActiveWorkbook.FullName & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1;Readonly=False"";"

' Exécute une requête SQL sur un jeu d'enregistrements:
StrSQL = "SELECT " & Fields & " FROM " & "[" & ActiveSheet.Name & "$] " & StrSQL
Set Rs = CreateObject("ADODB.Recordset") ' Liaison anticipée => Set Rs = New ADODB.Recordset
Rs.Open StrSQL, Cnn, 1, 2, 1 ' Liaison anticipée => adOpenKeyset, adLockPessimistic, adCmdText

' S'il y a des enregistrements concernés:
If Rs.EOF = False Then
Rs.MoveFirst                     ' Replace le pointeur au début (facultatif).
Cells.NumberFormat = "General"   ' Force le format général (pour les dates).
Range("A1").CopyFromRecordset Rs ' Affiche les enregistrements.
Dim y1 As Long, y2 As Long, x As Integer
y1 = Rs.RecordCount
y2 = List.Count
x = Rs.Fields.Count
Set Rs = Nothing
Set Cnn = Nothing
' Supprime les lignes et les colonnes en trop:
Rows(y1 + 1 & ":" & y2 + 1).Delete
For j = UBound(List.Item(0)) + 2 To x + 1 Step -1
Columns(j).Delete
Next j
' Charge les données sélectionnées par la requête:
Set ListFromSQL = ListFromRange([A1])
End If

' Fin du traitement:
Gest_Err:
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
Application.EnableEvents = Anc_EnableEvents
Application.ScreenUpdating = Anc_ScreenUpdating

If Err.Number = -2147217904 Then Err.Clear ' pas de donnée.
If Err.Number <> 0 Then Err.Raise Err.Number, "ListFromSQL", Err.Description
Err.Clear

End Function

'------------------------------------------------------------------------------------------------
Public Function ListFromCSV(ByVal FileFullPath As String) As Object
'------------------------------------------------------------------------------------------------
' Alimente un objet ArrayList à plusieurs dimensions depuis un fichier CVS au format anglo-saxo.
' Délimiteur = virgule, Dates = Année/mois/jour, Séparateur numérique = point.
'------------------------------------------------------------------------------------------------
' FileFullPath : le fichier CSV, avec son chemin.
'------------------------------------------------------------------------------------------------
' Renvoie : Une liste qui contient les données du fichier, au format français.
'------------------------------------------------------------------------------------------------
Dim NumFichier As Long, Taille As Long, y As Long, j As Integer
Dim Text As String
Dim Textlines As Variant, V As Variant, k As Variant

' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Correction du nom du fichier:
If UCase(Right(FileFullPath, 4)) <> ".CSV" Then FileFullPath = FileFullPath & ".csv"

' Ouvre le fichier:
NumFichier = FreeFile
Taille = FileLen(FileFullPath)

Open FileFullPath For Binary Access Read As #NumFichier
Text = Space(Taille)
Get #NumFichier, , Text
Textlines = Split(Text, vbCrLf)
Text = ""

' Ferme le fichier:
Close #NumFichier

' Création d'une nouvelle liste:
Dim List As Object
Set List = CreateObject("System.Collections.ArrayList")

' Boucle sur les lignes du fichier:
For y = 0 To UBound(Textlines)
' Récupère la ligne:
V = Split(Textlines(y), ",")
' Boucle sur les colonnes pour remplacer "." par "," sur les numériques:
For j = 0 To UBound(V)
V(j) = Replace(V(j), ";", ",")
If InStr(1, V(j), ".") > 0 Then
k = Replace(V(j), ".", ",")
If IsNumeric(k) = True Then V(j) = k
End If
Next j
' Transfert les données de la ligne dans la liste:
List.Add V
Next y

' Renvoie la liste:
Set ListFromCSV = List.Clone

' Fin du traitement:
Gest_Err:
If Err.Number <> 0 Then Err.Raise Err.Number, "ListFromCSV", Err.Description
Err.Clear

End Function

'------------------------------------------------------------------------------------------------
Public Function ListToCSV(List As Object, ByVal FileFullPath As String) As Boolean
'------------------------------------------------------------------------------------------------
' Créé un fichier texte CSV (Comma-separated values) au format anglo-saxo, depuis un objet
' ArrayList à plusieurs dimensions.
' Délimiteur = virgule, Dates = Année/mois/jour, Séparateur numérique = point.
'------------------------------------------------------------------------------------------------
' List : L'objet ArrayList qui contient les données.
' FileFullPath : Le fichier à créer, avec son chemin.
'------------------------------------------------------------------------------------------------
' Renvoie : True si tout s'est bien passé, False dans l'autre cas.
'------------------------------------------------------------------------------------------------
Dim V As Variant, E As Variant, j As Integer

' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Bloucle sur les données pour les transformer en lignes de texte avec de délimiteur demandé:
For Each E In List
ReDim S(0 To UBound(List.Item(0)))
For j = 0 To UBound(List.Item(0))
' Correction des données suivant leur type:
Select Case TypeName(E(j))
Case "String": S(j) = Replace(E(j), ",", ";")  ' Remplacer virgule par point-virgule.
Case "Date": S(j) = Year(E(j)) & "/" & Month(E(j)) & "/" & Day(E(j)) ' Format anglo-saxon.
Case "Empty": S(j) = "" ' Remplace Null par vide.
Case Else: S(j) = Replace(E(j), ",", ".") ' Numérique avec un point et pas une virgule.
End Select
Next j
V = V & Join(S, ",") & vbCrLf ' Ligne avec virgule et fin de ligne CRLF.
Next E

' Supprime le dernier CRLF:
V = Left(V, Len(V) - 2)

' Correction du nom du fichier:
If UCase(Right(FileFullPath, 4)) <> ".CSV" Then FileFullPath = FileFullPath & ".csv"

' Création du fichier texte en ANSII:
Dim oStream As Object
Set oStream = CreateObject("ADODB.Stream")
With oStream
.Charset = "iso-8859-1" ' et non pas "UTF-8" pour être en ANSII.
.Open
.Type = 2 ' 1 = Binaire, 2 = Texte (valeur par défaut).
.WriteText V
.SaveToFile FileFullPath, 2  ' 1 = no overwrite, 2 = overwrite.
.Close
End With

' Renvoie VRAI:
ListToCSV = True

' Fin du traitement:
Gest_Err:
If Err.Number <> 0 Then Err.Raise Err.Number, "ListToCSV", Err.Description
Err.Clear

End Function

'----------------------------------------------------------------------------------------
Public Function ListAddList(List As Object, ListAdd As Object, _
Optional ByVal ArrayColumnCompareValue As Variant = "", _
Optional MatchCase As Boolean = True) As Boolean
'----------------------------------------------------------------------------------------
' Ajoute les éléments d'une liste qui répondent aux critères de sélection passés en argument
' à une autre liste.
'----------------------------------------------------------------------------------------
' List : L'objet ArrayList à plusieurs dimensions qui sera alimenté.
' ListAdd : L'objet ArrayList à plusieurs dimensions qui contient les données source.
' ArrayColumnCompareValue : Array des couples "Colonne", "Opérateur", "Valeur".
' MatchCase : True pour que la recherche respecte la casse, False dans l'autre cas.
'----------------------------------------------------------------------------------------
' Renvoie : True si tout s'est bien passé ou False dans le cas contraire.
'----------------------------------------------------------------------------------------
Dim E As Variant, j As Integer

' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Analyse de l'argument:
If IsArray(ArrayColumnCompareValue) = False Then ArrayColumnCompareValue = Array(ArrayColumnCompareValue)

' S'il faut tout reprendre:
If ArrayColumnCompareValue(0) = "" Then
List.AddRAnge ListAdd
ListAddList = True
GoTo Gest_Err
End If

' S'il ne faut reprendre que certaines données:
For Each E In ListAdd
For j = 0 To UBound(ArrayColumnCompareValue) Step 3
ArrayColumnCompareValue(j) = VbValue(ArrayColumnCompareValue(j))
If VbCompare(E(ArrayColumnCompareValue(j)), ArrayColumnCompareValue(j + 1), ArrayColumnCompareValue(j + 2), MatchCase) = False Then Exit For
Next j
If j > UBound(ArrayColumnCompareValue) Then List.Add E
Next E
ListAddList = True

' Fin du traitement:
Gest_Err:
If Err.Number <> 0 Then
Err.Raise Err.Number, "ListAddList", Err.Description
End If
Err.Clear

End Function

'----------------------------------------------------------------------------------------
Public Function ListAddcolumns(List As Object, Columns As Integer, Optional Index As Boolean = False) As Boolean
'----------------------------------------------------------------------------------------
' Ajoute ou supprime des colonnes à un objet ArrayList à plusieurs dimensions.
'----------------------------------------------------------------------------------------
' List : L'objet ArrayList à plusieurs dimensions.
' Columns : Le nombre de colonnes à ajouter, ou à supprimer si Columns est néfatif.
' Index : si True alors indique la position de l'élément dans la dernière colonne.
'----------------------------------------------------------------------------------------
' Renvoie : True si tout s'est bien passé ou False dans le cas contraire.
'----------------------------------------------------------------------------------------
Dim Nb As Integer
Dim E As Variant
Dim ListTps As Object
Dim Pos As Long

' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Création d'un objet ArrayList temporaire:
Set ListTps = CreateObject("System.Collections.ArrayList")

' Calcule le nouveau nombre de colonnes:
Nb = UBound(List.Item(0)) + Columns
Dim V

' Boucle sur la liste d'origine:
For Each E In List
' Mémorise les données actuelles:
V = E
' Dimensionne au nombre de colonnes désirées:
ReDim Preserve V(0 To Nb)
' S'il faut indiquer l'indexation à la dernière colonne:
If Index = True Then V(Nb) = Pos: Pos = Pos + 1
' Ajoute ces données à la liste temporaire:
ListTps.Add V
Next E

' Renvoie une liste avec le nombre de colonnes désirées (avec des vides pour les colonnes ajoutées)
Set List = ListTps.Clone
ListAddcolumns = True

' Fin du traitement:
Gest_Err:
If Err.Number <> 0 Then
Err.Raise Err.Number, "ListAddcolumns", Err.Description
End If
Err.Clear

End Function

'----------------------------------------------------------------------------------------
Public Function ListToTable(List As Object, Action As String, TS As Range) As Boolean
'----------------------------------------------------------------------------------------
' Alimente un tableau structuré des données d'un objet ArrayList, soit en remplaçant les
' donnnées existantes soit en y ajoutant les nouvelles données.
'----------------------------------------------------------------------------------------
' List : L'objet ArrayList à plusieurs dimensions.
' TS : Le tableau structuré.
' Action :
' "=" Remplace : Les colonnes non renseignées sont vides, les colonnes en plus sont ignorées.
' "+" Ajoute : Les colonnes non renseignées sont vides, les colonnes en plus sont ignorées.
'----------------------------------------------------------------------------------------
' Renvoie : True si tout s'est bien passé ou False dans le cas contraire.
'----------------------------------------------------------------------------------------
' Remarque : Je n'utilise pas toujours WorksheetFunction.Transpose(List.ToArray) car je
' n'ai pas confiance sur des tableaux de plus de 65534 lignes et ça met #N/A sur les
' colonnes en surplus.
'----------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Si le tableau est vierge il faut l'initialiser:
If TS.ListObject.ListRows.Count = 0 Then
Set TS = TS.ListObject.ListRows.Add.Range
TS.ListObject.DataBodyRange.Clear
End If

' Dimensionne la mémoire qui va contenir les données à incorporer au tableau:
Dim x As Integer
x = UBound(List.Item(0)) + 1
If TS.ListObject.ListColumns.Count > x Then x = TS.ListObject.ListColumns.Count
ReDim Mémoire(1 To List.Count, 1 To x)

' Mémorise les données:
Dim Ligne As Long, Colonne As Integer, NbColonne As Integer
NbColonne = UBound(List.Item(0)) + 1
If NbColonne > TS.ListObject.ListColumns.Count Then NbColonne = TS.ListObject.ListColumns.Count

' Soit on peut utiliser List.ToArray soit on utilise un transfert manuel:
If UBound(List.Item(0)) + 1 = TS.ListObject.ListColumns.Count _
And List.Count < 65534 Then
Mémoire = WorksheetFunction.Transpose(WorksheetFunction.Transpose(List.ToArray))
Else
Dim E
Ligne = 0
For Each E In List
Ligne = Ligne + 1
For Colonne = 1 To NbColonne
Mémoire(Ligne, Colonne) = E(Colonne - 1)
Next Colonne
Next E
End If

' Suivant le mode d'action demandé, remplace ou ajoute les données:
Select Case Action

Case "=" ' Remplace les données:
If List.Count < TS.ListObject.ListRows.Count Then ' Efface les lignes en trop.
TS.ListObject.DataBodyRange.Rows(List.Count + 1 & ":" & TS.ListObject.ListRows.Count).Delete
Else ' Dimensionne le tableau à la bonne taille.
TS.ListObject.Resize Range(Cells(TS.Row - 1, TS.Column), Cells(TS.Row - 1 + List.Count, TS.Column + TS.ListObject.ListColumns.Count - 1))
End If
' Pose les données mémorisées:
TS.ListObject.DataBodyRange.FormulaLocal = Mémoire

Case "+" ' Pose à la suite les nouvelles données mémorisées:
TS.Cells(TS.Rows.Count + 1, 1).Resize(List.Count, NbColonne).FormulaLocal = Mémoire

Case Else: Err.Raise vbError, "", "Erreur de programmation" & vbCrLf & "Action non connue : " & Action

End Select

' Renvoie Vrai:
ListToTable = True

' Fin du traitement:
Gest_Err:
If Err.Number <> 0 Then
Err.Raise Err.Number, "ListToTable", Err.Description
End If
Err.Clear

End Function

'----------------------------------------------------------------------------------------
Public Function ListIndexOf(List As Object, _
ByVal ArrayColumnCompareValue As Variant, _
Optional MatchCase As Boolean = True, _
Optional Sorted As Boolean = False) As Long
'----------------------------------------------------------------------------------------
' Renvoie la position (en base 0) d'un élément dans l'objet ArrayList à plusieurs dimensions.
'----------------------------------------------------------------------------------------
' List : L'objet ArrayList à plusieurs dimensions.
' ArrayColumnCompareValue : Array des couples "Colonne", "Opérateur", "Valeur".
' MatchCase : True pour que la recherche respecte la casse, False dans l'autre cas.
' Sorted : True si la liste est triée par ordre croissant et que l'on peut faire une
'          recherche dichotomique sur le premier couple passé dans ArrayColumnCompareValue.
'----------------------------------------------------------------------------------------
' Renvoie : La position (en base 0) dans l'objet ArrayList du premier élément trouvé qui
'           correspond aux critères de recherche, ou -1 si non trouvé.
'----------------------------------------------------------------------------------------
Dim i As Long, j As Integer, Début As Long
Dim Colonne As Integer, Valeur As Variant
Dim E

' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Par défaut renvoie -1:
ListIndexOf = -1

' Si la liste est triée et que l'on cherche une valeur:
If Sorted = True And ArrayColumnCompareValue(1) = "=" Then
Colonne = VbValue(ArrayColumnCompareValue(0))
Valeur = ArrayColumnCompareValue(2)
Début = RechercheDichotomique(List, Colonne, Valeur, MatchCase)
If Début < 0 Then GoTo Gest_Err
For i = Début To List.Count - 1
If VbCompare(List.Item(i)(Colonne), "<>", Valeur, MatchCase) Then GoTo Gest_Err
For j = 0 To UBound(ArrayColumnCompareValue) Step 3
ArrayColumnCompareValue(j) = VbValue(ArrayColumnCompareValue(j))
If VbCompare(E(ArrayColumnCompareValue(j)), ArrayColumnCompareValue(j + 1), ArrayColumnCompareValue(j + 2), MatchCase) = False Then Exit For
Next j
If j > UBound(ArrayColumnCompareValue) Then ListIndexOf = i: GoTo Gest_Err
Next i
GoTo Gest_Err
End If

' Traitement si la liste n'est pas triée:
For Each E In List
For j = 0 To UBound(ArrayColumnCompareValue) Step 3
ArrayColumnCompareValue(j) = VbValue(ArrayColumnCompareValue(j))
If VbCompare(E(ArrayColumnCompareValue(j)), ArrayColumnCompareValue(j + 1), ArrayColumnCompareValue(j + 2), MatchCase) = False Then Exit For
Next j
If j > UBound(ArrayColumnCompareValue) Then ListIndexOf = i: Exit For
i = i + 1
Next E

' Fin du traitement:
Gest_Err:
If Err.Number <> 0 Then
Err.Raise Err.Number, "ListIndexOf", Err.Description
End If
Err.Clear

End Function

'----------------------------------------------------------------------------------------
Public Function ListContains(List As Object, _
ByVal ArrayColumnCompareValue As Variant, _
Optional MatchCase As Boolean = True, _
Optional Sorted As Boolean = False) As Boolean
'----------------------------------------------------------------------------------------
' Indique si un élément dans l'objet ArrayList à plusieurs dimensions est présent ou non.
'----------------------------------------------------------------------------------------
' List : L'objet ArrayList à plusieurs dimensions.
'
' ArrayColumnCompareValue : Array des couples "Colonne", "Opérateur", "Valeur".
' MatchCase : True pour que la recherche respecte la casse, False dans l'autre cas.
' Sorted : True si la liste est triée par ordre croissant et que l'on peut faire une
'          recherche dichotomique sur le premier couple passé dans ArrayColumnCompareValue.
'----------------------------------------------------------------------------------------
' Renvoie : True si trouvé ou False si non trouvé.
'----------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Traitement:
ListContains = ListIndexOf(List, ArrayColumnCompareValue, MatchCase) > -1

' Fin du traitement:
Gest_Err:
If Err.Number <> 0 Then
Err.Raise Err.Number, "ListContains", Err.Description
End If
Err.Clear

End Function

'----------------------------------------------------------------------------------------
Public Sub ListSort(List As Object, ByVal ArrayColumns As Variant, _
Optional MatchCase As Boolean = True)
'----------------------------------------------------------------------------------------
' Trie par ordre croissant un objet ArrayList à plusieurs dimensions.
'----------------------------------------------------------------------------------------
' List : L'objet ArrayList à plusieurs dimensions.
' ArrayColumns : Liste des colonnes (en Array et en base 0) sur lesquelles portent le tri.
' MatchCase : True pour que le tri respecte la casse, False dans l'autre cas.
'----------------------------------------------------------------------------------------
Dim i As Long, j As Integer, Column As Integer
Dim E As Variant

' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Analyse de l'argument:
If IsArray(ArrayColumns) = False Then ArrayColumns = Array(ArrayColumns)

' Trie sur la première colonne en utilisant QS optimisé pour les variables à
' plusieurs dimensions.
' Moins rapide que QuickRanking mais plus simple:
' https://laurent-ott.developpez.com/tutoriels/programmation-excel-vba-tome-1/
Column = VbValue(ArrayColumns(0))
ReDim TabDonnées(0 To List.Count - 1)
ReDim Ref(0 To List.Count - 1) As Long

For Each E In List
TabDonnées(i) = E
Ref(i) = i
i = i + 1
Next E

Select Case MatchCase
Case True: Call QS(TabDonnées(), Ref(), LBound(TabDonnées), UBound(TabDonnées), Column)
Case False: Call QS_NoMatchCase(TabDonnées(), Ref(), LBound(TabDonnées), UBound(TabDonnées), Column)
End Select

List.Clear
For i = 0 To UBound(TabDonnées)
List.Add TabDonnées(Ref(i))
Next i

' Trie sur les colonnes suivantes:
For j = 1 To UBound(ArrayColumns)
Call ListSortLevel2(List, MatchCase, VbValue(ArrayColumns(j - 1)), VbValue(ArrayColumns(j)))
Next j

' Fin du traitement:
Gest_Err:
If Err.Number <> 0 Then
Err.Raise Err.Number, "ListSort", Err.Description
End If
Err.Clear

End Sub

'----------------------------------------------------------------------------------------
Private Sub ListSortLevel2(List As Object, MatchCase As Boolean, _
Index1 As Integer, Index2 As Integer)
'----------------------------------------------------------------------------------------
' A partir d'une liste déjà triée sur la dimension Index1, fait un second tri sur la
' dimension Index2.
'----------------------------------------------------------------------------------------
Dim i As Long, ik As Long, j As Long, Trier As Boolean

While i < List.Count

Trier = False
ReDim TabDonnées(0 To List.Count - 1)
ReDim Ref(0 To List.Count - 1) As Long
TabDonnées(0) = List(i)
ik = 1

Do
If i + ik = List.Count Then Exit Do
If VbCompare(List.Item(i)(Index1), "<>", List.Item(i + ik)(Index1), MatchCase) Then Exit Do
TabDonnées(ik) = List(i + ik)
Ref(ik) = ik
If VbCompare(TabDonnées(ik)(Index2), "<", TabDonnées(ik - 1)(Index2), MatchCase) Then Trier = True
ik = ik + 1
Loop

If Trier = True Then
ReDim Preserve TabDonnées(0 To ik - 1)
ReDim Preserve Ref(0 To ik - 1) As Long
Select Case MatchCase
Case True: Call QS(TabDonnées(), Ref(), LBound(TabDonnées), UBound(TabDonnées), Index2)
Case False: Call QS_NoMatchCase(TabDonnées(), Ref(), LBound(TabDonnées), UBound(TabDonnées), Index2)
End Select
For j = 0 To ik - 1
List(i + j) = TabDonnées(Ref(j))
Next j
End If

i = i + ik

Wend

End Sub

'----------------------------------------------------------------------------------------
Private Sub QS(TabDonnées() As Variant, Ref() As Long, Gauche As Long, Droite As Long, Colonne)
'----------------------------------------------------------------------------------------
Dim i As Long, j As Long, Tps As Long, ValQS As Variant

i = Gauche
j = Droite
ValQS = TabDonnées(Ref((Gauche + Droite) / 2))(Colonne)

Do
While ValQS > TabDonnées(Ref(i))(Colonne): i = i + 1: Wend
While ValQS < TabDonnées(Ref(j))(Colonne): j = j - 1: Wend

If j + 1 > i Then
Tps = Ref(i)
Ref(i) = Ref(j)
Ref(j) = Tps
j = j - 1: i = i + 1
End If

Loop Until i > j

If Gauche < j Then Call QS(TabDonnées(), Ref(), Gauche, j, Colonne)
If i < Droite Then Call QS(TabDonnées(), Ref(), i, Droite, Colonne)

End Sub

'----------------------------------------------------------------------------------------
Private Sub QS_NoMatchCase(TabDonnées() As Variant, Ref() As Long, Gauche As Long, Droite As Long, Colonne)
'----------------------------------------------------------------------------------------
Dim i As Long, j As Long, Tps As Long, ValQS As Variant

i = Gauche
j = Droite
ValQS = TabDonnées(Ref((Gauche + Droite) / 2))(Colonne)

Do
While VbCompare(ValQS, ">", TabDonnées(Ref(i))(Colonne), False): i = i + 1: Wend
While VbCompare(ValQS, "<", TabDonnées(Ref(j))(Colonne), False): j = j - 1: Wend

If j + 1 > i Then
Tps = Ref(i)
Ref(i) = Ref(j)
Ref(j) = Tps
j = j - 1: i = i + 1
End If

Loop Until i > j

If Gauche < j Then Call QS_NoMatchCase(TabDonnées(), Ref(), Gauche, j, Colonne)
If i < Droite Then Call QS_NoMatchCase(TabDonnées(), Ref(), i, Droite, Colonne)

End Sub

'----------------------------------------------------------------------------------------
Public Sub ListUnique(List As Object, Optional MatchCase As Boolean = True)
'----------------------------------------------------------------------------------------
' Transforme l'objet ArrayList passé dans l'argument List pour supprimer les doublons.
' L'objet ArrayList peut être à une dimension ou à plusieurs et dans ce cas toutes les
' dimensions des éléments sont analysées pour déterminer s'il y a un doublon.
' Tous les éléments de l'objet ArrayList doivent avoir la même dimension.
'----------------------------------------------------------------------------------------
' List : L'objet ArrayList à plusieurs dimensions.
' MatchCase : True pour que la recherche respecte la casse, False dans l'autre cas.
'----------------------------------------------------------------------------------------
' Remarque : la liste unique est automatiquement classée par ordre croissant.
'----------------------------------------------------------------------------------------
Dim i As Long, j As Long
Dim E As Variant, NbDimension As Integer

' Définition du nombre de colonnes dans la liste source:
On Error Resume Next
NbDimension = -1
NbDimension = UBound(List.Item(0))
On Error GoTo 0

' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Création d'une liste où ne seront repris que les éléments uniques:
Dim Unique As Object
Set Unique = CreateObject("System.Collections.ArrayList")

Select Case NbDimension

' Cas d'un objet ArrayList classique:
Case -1

' Trie la liste:
List.Sort
' S'il faut respecter la casse:
If MatchCase = True Then
For Each E In List
If Not Unique.Contains(E) Then Unique.Add E
Next E
Else ' Sinon boucle sur les éléments et les compare en majuscules au précédent:
Unique.Add List.Item(i)
For i = 1 To List.Count - 1
If UCase(List.Item(i)) <> UCase(List.Item(i - 1)) Then Unique.Add List.Item(i)
Next i
End If

' Cas d'un objet ArrayList à plusieurs dimensions:
Case Else

' Trie la liste sur toutes ses dimensions:
Dim V As Variant
ReDim V(0 To NbDimension)
For j = 0 To NbDimension: V(j) = j: Next j
Call ListSort(List, V, MatchCase)
' Boucle sur les éléments pour les comparer au précédent:
Unique.Add List.Item(0)
For i = 1 To List.Count - 1
For j = 0 To NbDimension
If VbCompare(List.Item(i)(j), "<>", List.Item(i - 1)(j), MatchCase) Then Exit For
Next j
If j <= NbDimension Then Unique.Add List.Item(i)
Next i

End Select

' Modifie la liste d'origine en liste unique triée par ordre de ses colonnes:
Set List = Unique.Clone

' Fin du traitement:
Gest_Err:
If Err.Number <> 0 Then
Err.Raise Err.Number, "ListUnique", Err.Description
End If
Err.Clear

End Sub

'----------------------------------------------------------------------------------------
Public Function ListUpdateItem(List As Object, Column As Variant, _
Action As String, Value As Variant, _
Item As Long) As Boolean
'----------------------------------------------------------------------------------------
' Fait la mise à jour d'une colonne dans l'objet ArrayList à plusieurs dimensions
' pour l'élément indiqué.
'----------------------------------------------------------------------------------------
' List : L'objet ArrayList à plusieurs dimensions.
' Column : La colonne (en base 0) dont il faut faire la mise à jour.
' Action : "=" Modification.
'          "+" Ajout.
'          "-" Soustraction
'          "*" Multiplication
'          "/" Division
' Value : La nouvelle valeur pour la colonne.
' Item : La position de l'élément à mettre à jour.
'----------------------------------------------------------------------------------------
' Renvoie : True si tout s'est bien passé ou False dans le cas contraire.
'----------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Traitement:
Call ListUpdateElement(List, Item, VbValue(Column), Action, Value)
ListUpdateItem = True

' Fin du traitement:
Gest_Err:
If Err.Number <> 0 Then
Err.Raise Err.Number, "ListUpdateItem", Err.Description
End If
Err.Clear

End Function

'----------------------------------------------------------------------------------------
Public Function ListUpdateAll(List As Object, Column As Integer, _
Action As String, Value As Variant, _
ByVal ArrayColumnCompareValue As Variant, _
Optional MatchCase As Boolean = True) As Boolean
'----------------------------------------------------------------------------------------
' Fait la mise à jour d'une colonne dans l'objet ArrayList à plusieurs dimensions
' pour les éléments qui correspondent aux critères indiqués dans les arguments.
'----------------------------------------------------------------------------------------
' List : L'objet ArrayList à plusieurs dimensions.
' Column : La colonne (en base 0) dont il faut faire la mise à jour.
' Value : La nouvelle valeur pour la colonne.
' Action : "=" Modification.
'          "+" Ajout.
'          "-" Soustraction
'          "*" Multiplication
'          "/" Division
' ArrayColumnCompareValue : Array des couples "Colonne", "Opérateur", "Valeur"
' MatchCase : True pour que la recherche respecte la casse, False dans l'autre cas,
'             si ArrayColumnCompareValue est un Array et non pas la position de l'élément.
'----------------------------------------------------------------------------------------
' Renvoie : True si tout s'est bien passé ou False dans le cas contraire.
'----------------------------------------------------------------------------------------
Dim i As Long, j As Integer
ReDim V(0 To UBound(List.Item(0)))
Dim E

' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Création d'une liste temporaire qui contient les données source
' afin de pouvoir faire une boucle For Each plus rapide que For Next:
Dim ListTps As Object
Set ListTps = CreateObject("System.Collections.ArrayList")
Set ListTps = List.Clone

' Boucle sur tous les éléments pour trouver ceux qui correspondent aux
' critères indiqués dans les arguments et les modifier dans la liste source:
For Each E In ListTps
For j = 0 To UBound(ArrayColumnCompareValue) Step 3
ArrayColumnCompareValue(j) = VbValue(ArrayColumnCompareValue(j))
If VbCompare(E(ArrayColumnCompareValue(j)), ArrayColumnCompareValue(j + 1), ArrayColumnCompareValue(j + 2), MatchCase) = False Then Exit For
Next j
If j > UBound(ArrayColumnCompareValue) Then
Call ListUpdateElement(List, i, VbValue(Column), Action, Value)
ListUpdateAll = True
End If
i = i + 1
Next E

' Fin du traitement:
Gest_Err:
If Err.Number <> 0 Then
Err.Raise Err.Number, "ListUpdateAll", Err.Description
End If
Err.Clear

End Function

'----------------------------------------------------------------------------------------
Private Sub ListUpdateElement(List As Object, i As Long, Index As Integer, _
Action As String, Value As Variant)
'----------------------------------------------------------------------------------------
ReDim V(0 To UBound(List.Item(0)))

' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Mémorise les données de l'élément:
V = List.Item(i)

' Modifie la valeur de la colonne concernée avec la valeur passée suivant
' l'action à effectuer:
Select Case Action
Case "=": V(Index) = Value
Case "+": V(Index) = Value + V(Index)
Case "-": V(Index) = V(Index) - Value
Case "*": V(Index) = V(Index) * Value
Case "/": V(Index) = V(Index) / Value
Case "\": V(Index) = V(Index) \ Value
Case Else: Err.Raise vbError, "", "Erreur de programmation" & vbCrLf & "Action non connue : " & Action
End Select

' Corrige l'élément:
List.Item(i) = V()

' Fin du traitement:
Gest_Err:
If Err.Number <> 0 Then
Err.Raise Err.Number, "ListUpdateElement", Err.Description
End If
Err.Clear

End Sub

'----------------------------------------------------------------------------------------
Public Function ListAddItem(List As Object, ArrayValues As Variant, _
Optional ByVal Index As Long = -1) As Boolean
'----------------------------------------------------------------------------------------
' Ajoute un élément à la liste.
'----------------------------------------------------------------------------------------
' List : L'objet ArrayList à plusieurs dimensions.
' ArrayValues : Array des valeurs à ajouter (dans l'ordre des colonnes de l'objet).
' Index : La position où insérer l'élément dans la liste (en base 0), on -1 pour
'         l'ajouter à la suite de la liste.
'----------------------------------------------------------------------------------------
' Renvoie : True si tout s'est bien passé, False dans le cas contraire.
'----------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Correction:
If Index = -1 Then Index = List.Count

' Traitement:
List.Insert Index, ArrayValues
ListAddItem = True

' Fin du traitement:
Gest_Err:
If Err.Number <> 0 Then
Err.Raise Err.Number, "ListAddItem", Err.Description
End If
Err.Clear

End Function

'----------------------------------------------------------------------------------------
Public Function ListRemove(List As Object, _
ByVal ArrayColumnCompareValue As Variant, _
Optional MatchCase As Boolean = True) As Long
'----------------------------------------------------------------------------------------
' Supprime les éléments dans l'objet ArrayList à plusieurs dimensions qui correspondent à
' la méthode de comparaison et aux critères de recherche indiqués dans les arguments.
'----------------------------------------------------------------------------------------
' List : L'objet ArrayList à plusieurs dimensions.
' ArrayColumnCompareValue : Array des couples "Colonne", "Opérateur", "Valeur".
' MatchCase : True pour que la recherche respecte la casse, False dans l'autre cas.
'----------------------------------------------------------------------------------------
' Renvoie : Le nombre d'éléments supprimés.
'----------------------------------------------------------------------------------------
Dim i As Long, j As Integer

' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Traitement:
For i = List.Count - 1 To 0 Step -1
For j = 0 To UBound(ArrayColumnCompareValue) Step 3
ArrayColumnCompareValue(j) = VbValue(ArrayColumnCompareValue(j))
If VbCompare(List.Item(i)(ArrayColumnCompareValue(j)), ArrayColumnCompareValue(j + 1), ArrayColumnCompareValue(j + 2), MatchCase) = False Then Exit For
Next j
If j > UBound(ArrayColumnCompareValue) Then List.RemoveAt i: ListRemove = ListRemove + 1
Next i

' Fin du traitement:
Gest_Err:
If Err.Number <> 0 Then
Err.Raise Err.Number, "ListRemove", Err.Description
End If
Err.Clear

End Function

'----------------------------------------------------------------------------------------
Public Function ListCount(List As Object, _
ByVal ArrayColumnCompareValue As Variant, _
Optional MatchCase As Boolean = True, _
Optional Sorted As Boolean = False) As Long
'----------------------------------------------------------------------------------------
' Compte le nombre d'éléments dans l'objet ArrayList à plusieurs dimensions qui correspondent
' à la méthode de comparaison et aux critères de recherche indiqués dans les arguments.
'----------------------------------------------------------------------------------------
' List : L'objet ArrayList à plusieurs dimensions.
' ArrayColumnCompareValue : Array des couples "Colonne", "Opérateur", "Valeur".
' MatchCase : True pour que la recherche respecte la casse, False dans l'autre cas.
' Sorted : True si la liste est triée par ordre croissant et que l'on peut faire une
'          recherche dichotomique sur le premier couple passé dans ArrayColumnCompareValue.
'----------------------------------------------------------------------------------------
' Renvoie : Le nombre d'éléments comptés.
'----------------------------------------------------------------------------------------
Dim i As Long, j As Integer, Début As Long
Dim Colonne As Integer, Valeur As Variant
Dim E As Variant

' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Si la liste est triée et que l'on cherche une valeur:
If Sorted = True And ArrayColumnCompareValue(j + 1) = "=" Then
Colonne = VbValue(ArrayColumnCompareValue(0))
Valeur = ArrayColumnCompareValue(2)
Début = RechercheDichotomique(List, Colonne, Valeur, MatchCase)
If Début < 0 Then GoTo Gest_Err
For i = Début To List.Count - 1
If VbCompare(List.Item(i)(Colonne), "<>", Valeur, MatchCase) Then GoTo Gest_Err
For j = 0 To UBound(ArrayColumnCompareValue) Step 3
ArrayColumnCompareValue(j) = VbValue(ArrayColumnCompareValue(j))
If VbCompare(List.Item(i)(ArrayColumnCompareValue(j)), ArrayColumnCompareValue(j + 1), ArrayColumnCompareValue(j + 2), MatchCase) = False Then Exit For
Next j
If j > UBound(ArrayColumnCompareValue) Then ListCount = ListCount + 1
Next i
GoTo Gest_Err
End If

' Traitement si la liste n'est pas triée:
For Each E In List
For j = 0 To UBound(ArrayColumnCompareValue) Step 3
ArrayColumnCompareValue(j) = VbValue(ArrayColumnCompareValue(j))
If VbCompare(E(ArrayColumnCompareValue(j)), ArrayColumnCompareValue(j + 1), ArrayColumnCompareValue(j + 2), MatchCase) = False Then Exit For
Next j
If j > UBound(ArrayColumnCompareValue) Then ListCount = ListCount + 1
Next E

' Fin du traitement:
Gest_Err:
If Err.Number <> 0 Then
Err.Raise Err.Number, "ListCount", Err.Description
End If
Err.Clear

End Function

'----------------------------------------------------------------------------------------
Public Function ListSum(List As Object, ByVal Column As Variant, _
ByVal ArrayColumnCompareValue As Variant, _
Optional MatchCase As Boolean = True, _
Optional Sorted As Boolean = False) As Double
'----------------------------------------------------------------------------------------
' Fait la somme des valeurs d'une colonne pour les éléments d'un objet ArrayList
' à plusieurs dimensions qui correspondent à la méthode de comparaison et aux critères
' de recherche indiqués dans les arguments.
'----------------------------------------------------------------------------------------
' List : L'objet ArrayList à plusieurs dimensions.
' Column : La colonne (en base 0) dont il faut faire la somme.
' ArrayColumnCompareValue : Array des couples "Colonne", "Opérateur", "Valeur".
' MatchCase : True pour que la recherche respecte la casse, False dans l'autre cas.
' Sorted : True si la liste est triée par ordre croissant et que l'on peut faire une
'          recherche dichotomique sur le premier couple passé dans ArrayColumnCompareValue.
'----------------------------------------------------------------------------------------
' Renvoie : La somme trouvée.
'----------------------------------------------------------------------------------------
Dim i As Long, j As Integer, Début As Long
Dim Colonne As Integer, Valeur As Variant
Dim E As Variant

' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Si la liste est triée et que l'on cherche une valeur:
If Sorted = True And ArrayColumnCompareValue(j + 1) = "=" Then
Valeur = ArrayColumnCompareValue(2)
Colonne = VbValue(ArrayColumnCompareValue(0))
Début = RechercheDichotomique(List, Colonne, Valeur, MatchCase)
If Début < 0 Then GoTo Gest_Err
For i = Début To List.Count - 1
If VbCompare(List.Item(i)(Colonne), "<>", Valeur, MatchCase) Then GoTo Gest_Err
For j = 0 To UBound(ArrayColumnCompareValue) Step 3
ArrayColumnCompareValue(j) = VbValue(ArrayColumnCompareValue(j))
If VbCompare(List.Item(i)(ArrayColumnCompareValue(j)), ArrayColumnCompareValue(j + 1), ArrayColumnCompareValue(j + 2), MatchCase) = False Then Exit For
Next j
If j > UBound(ArrayColumnCompareValue) Then ListSum = ListSum + List.Item(i)(VbValue(Column))
Next i
GoTo Gest_Err
End If

' Traitement si la liste n'est pas triée:
For Each E In List
For j = 0 To UBound(ArrayColumnCompareValue) Step 3
ArrayColumnCompareValue(j) = VbValue(ArrayColumnCompareValue(j))
If VbCompare(E(ArrayColumnCompareValue(j)), ArrayColumnCompareValue(j + 1), ArrayColumnCompareValue(j + 2), MatchCase) = False Then Exit For
Next j
If j > UBound(ArrayColumnCompareValue) Then ListSum = ListSum + E(Column)
Next E

' Fin du traitement:
Gest_Err:
If Err.Number <> 0 Then
Err.Raise Err.Number, "ListSum", Err.Description
End If
Err.Clear

End Function

'----------------------------------------------------------------------------------------
Public Function VbCompare(ByVal Value1 As Variant, Op As Variant, ByVal Value2 As Variant, _
Optional MatchCase As Boolean = True) As Boolean
'----------------------------------------------------------------------------------------
' Compare Value1 avec Value2 suivant l'opérateur Op et s'il faut respecter ou non la casse.
'----------------------------------------------------------------------------------------
' Renvoie : Vrai si la comparaison correspond aux critères demandés.
'----------------------------------------------------------------------------------------
'If IsError(Value1) = True Then Exit Function
'If IsError(Value2) = True Then Exit Function
'----------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Traitement:
If MatchCase = False Then Value1 = UCase(Value1): Value2 = UCase(Value2)
Select Case Op
Case "=": If Value1 = Value2 Then VbCompare = True
Case "<>": If Value1 <> Value2 Then VbCompare = True
Case "<": If Value1 < Value2 Then VbCompare = True
Case ">": If Value1 > Value2 Then VbCompare = True
Case "<=": If Value1 <= Value2 Then VbCompare = True
Case ">=": If Value1 >= Value2 Then VbCompare = True
Case "?*": VbCompare = Value1 Like Value2 & "*" ' Commence par
Case "*?": VbCompare = Value1 Like "*" & Value2 ' Termine par
Case "*": VbCompare = Value1 Like "*" & Value2 & "*" ' Contient
Case Else: Err.Raise vbError, "", "Erreur de programmation" & vbCrLf & "Action non connue : " & Op
End Select

' Fin du traitement:
Gest_Err:
If Err.Number <> 0 Then
Err.Raise Err.Number, "VbCompare", Err.Description
End If
Err.Clear

End Function

'----------------------------------------------------------------------------------------
Private Function VbValue(ByVal Value As Variant) As Integer
'----------------------------------------------------------------------------------------
' Renvoie la valeur du contenu de la variable passée en argument.
'----------------------------------------------------------------------------------------
Dim i As Integer
Dim StrValue As String

' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

For i = 1 To Len(Value)
Select Case UCase(Mid(Value, i, 1))
Case 0 To 9: StrValue = StrValue & Mid(Value, i, 1)
End Select
Next i
VbValue = CDec(StrValue)

' Fin du traitement:
Gest_Err:
If Err.Number <> 0 Then
Err.Raise Err.Number, "VbValue", Err.Description
End If
Err.Clear

End Function

'----------------------------------------------------------------------------------------
Private Function RechercheDichotomique(List As Object, ByVal Column As Long, Value As Variant, _
MatchCase As Boolean) As Long
'----------------------------------------------------------------------------------------
' Fait une recherche dichotomique dans une liste triée par ordre croissant sur la colonne Column.
'----------------------------------------------------------------------------------------
' List : La liste qui contient les données.
' Column : La colonne triée (la 1ère colonne triée si le tri a porté sur plusieurs colonnes).
' Value : La valeur cherchée.
'----------------------------------------------------------------------------------------
' Renvoie : La position du premier élément qui contient la valeur cherchée ou -1.
'----------------------------------------------------------------------------------------
Dim Début As Long, i As Long, Fin As Long
Static Anc As Long

' Valeur par défaut:
RechercheDichotomique = -1

' Tests primaires:
Fin = List.Count - 1
If VbCompare(Value, ">", List.Item(Fin)(Column)) Then Exit Function
If VbCompare(Value, "<", List.Item(Début)(Column)) Then Exit Function

' Teste si l'élément suivant de la dernière recherche est la solution:
If Anc < Fin Then
If VbCompare(List.Item(Anc)(Column), "<>", Value) And VbCompare(List.Item(Anc + 1)(Column), "=", Value) Then
Anc = Anc + 1: RechercheDichotomique = Anc: Exit Function
End If
End If

' Recherche dichotomique:
Anc = 0
Do

i = (Début + Fin) / 2
If VbCompare(Value, ">", List.Item(i)(Column)) Then
Début = i + 1
Anc = Début
Else
Fin = i - 1
End If

Loop While Début <= Fin

' Renvoie la position trouvée:
If VbCompare(Value, "=", List.Item(Anc)(Column)) Then RechercheDichotomique = Anc
End Function
'----------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------