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

Gérer des données au-delà des capacités d'une feuille de calcul d'Excel

Laurent Ott

Cette documentation propose des fonctions en VBA pour Excel pour gérer de gros volumes de données qui peuvent dépasser les capacités d'une feuille de calcul d'Excel. Car une fois dépassées les 1 048 576 lignes disponibles les fonctions classiques d'Excel ne peuvent plus être utilisées.

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

- Auteur : Laurent Ott

- Parution : 1 janvier 2025

- Mise à jour : 1 avril 2025

- 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. Exercice pour mieux comprendre les fonctions utilisées

- II-A. DataFromRange - Charger des données depuis une feuille de calcul

- II-B. DataAddData - Concaténer deux tableaux de données

- II-C. DataRemove - Supprimer des éléments

- II-D. DataSort - Trier les données

- II-E. DataFromData - Copier certaines colonnes

- II-F. DataUnique - Générer une liste unique

- II-G. DataAddColumns - Ajouter (ou supprimer) des colonnes

- II-H. DataCount - Compter le nombre d’éléments

- II-I. DataSum - Faire la somme d’une colonne

- II-J. DataUpdateItem - Mettre à jour les données

- II-K. DataRank – Obtenir l'ordre de classement

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

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

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

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

- III. Le code source de l’exercice

- IV. DataFromSQL - Exécuter une requête SQL

- V. Conclusion

- VI. Remerciements

- VII. Le fichier joint

- VIII. Annexe 1 : Liste des fonctions

- IX. Annexe 2 : L'algorithme de classement Quick Rank

- X. Annexe 3 : Le code des fonctions pour ceux qui ne peuvent pas télécharger le fichier joint

I - Introduction

Au quotidien, pour gérer mes données j'utilise les tableaux « structurés » et les fonctions qui me simplifient la vie, disponibles dans cette documentation : Fonctions en VBA pour gérer les Tableaux Structurés d’Excel.
Sous réserve que mes données ne dépassent pas la taille d'une feuille de calcul d'Excel, limitée actuellement à 1 048 576 lignes.

Ça se complique donc lorsqu'il faut gérer 12 mois glissants de 600 000 lignes de données chacun pour générer un tableau de synthèse...

Alors en attendant une version d'Excel à deux milliards de lignes, j'ai dû développer des fonctions pour gérer de gros volumes de données.
Ces fonctions, je souhaite les partager avec vous dans cette documentation.

Les données étant en mémoire, les traitements peuvent gérer plusieurs millions de lignes.
Pour coller au plus près avec la logique d'une feuille de calcul d'Excel où la première cellule est en ligne 1, colonne 1, les mémoires utilisées sont toutes à deux dimensions et en base 1. Soit une déclaration de ce style : Dim Data(1 To y, 1 To x) As Variant où y est le nombre de lignes et x le nombre de colonnes.

Gérer des mémoires en base 1 permet de charger rapidement (et de façon dynamique) l’ensemble les données d’une plage (objet Range) ou d’un tableau structuré (objet ListObject) par les fonctions du VBA, et inversement de les restituer.

En base 0, il faudrait lire les données une à une en base 1 pour les écrire en mémoire en base 0, ce qui est chronophage.

Notez que lors du chargement des données d’une plage ou d’un tableau structuré, seule la valeur de la cellule (propriété Value) est mémorisée sous forme de Variant (c’est-à-dire que les dates sont gérées comme des dates, les numériques comme des numériques, etc.). Par contre les formules, les formats et autres propriétés sont ignorés.

Dans cette documentation, j'utiliserai souvent les termes « tableau de données » pour décrire ces mémoires et « colonnes » pour leur seconde dimension.

À l’appui d’un exercice simple, nous allons étudier dans les lignes qui suivent comment charger des données en mémoire pour les manipuler à notre guise avant, éventuellement, de les restituer sous forme de synthèse dans un tableau structuré.
Pour faciliter votre lecture, les données utilisées pour l'exercice sont restreintes, mais vous comprendrez que le principe sera identique avec de gros volumes.

II - 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, leur moyenne et leur classement. À 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-A - DataFromRange - Charger des données depuis une feuille de calcul

Pour commencer notre exercice, nous allons charger en mémoire les données de ces trois tableaux sources avec la fonction DataFromRange.

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 tableau de données en base 1.

Pour charger le tableau structuré, dans la mémoire « Données » préalablement déclarée par Dim Données(), nous indiquerons à la fonction de ne reprendre que les cinq premières colonnes (la colonne « Id » n’est pas souhaitée) :
Données = DataFromRange(Range("Tableau1"), Array(1, 2, 3, 4, 5))
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.
Notez également que Range("Tableau1") peut être remplacé par [Tableau1], tout dépend de vos habitudes de programmation.

Le deuxième tableau (plus précisément une plage de cellules) est chargé dans une autre mémoire, « Tps », que l’on concatènera à « 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 (les colonnes 4 et 5 sont inversées) :
Tps = DataFromRange(Sheets("Feuil5").Range("A1"), Array(1, 2, 3, 5, 4))

Enfin, pour le troisième tableau à charger (lui aussi une plage de cellules), 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 » :
Tps = DataFromRange(Sheets("Feuil6").Range("A2"))

Astuce : La fonction DataFromTxt charge dans une mémoire un fichier texte (par défaut les champs sont délimités par une tabulation mais vous pouvez définir le délimiteur à appliquer).

II-B - DataAddData - Concaténer deux tableaux de données

Revenons à l’étape où nous avons chargé le premier tableau dans la mémoire « Données » et le deuxième dans la mémoire « Tps ».
Pour ajouter les données de « Tps » à « Données », nous utilisons la fonction DataAddData.

Ses arguments sont :

- DataTable : La mémoire qui contient les données sources ;

- DataTableAdd : La mémoire qu’il faut ajouter à « DataTable » ;

- 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).

La fonction renvoie un tableau de données en base 1 qui reprend tout DataTable plus les données de DataTableAdd qui correspondent aux critères de sélection (vide pour tout reprendre).

Ce qui donne ceci pour ajouter toutes les données de « Tps » à « Données » :
Données = DataAddData(Données, Tps)

Nous ferons de même avec le troisième tableau pour obtenir une mémoire « 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 de DataTableAdd, par exemple quand les notes (colonne 3) sont supérieures à 0, soit :
Données = DataAddData(Données, Tps, Array(3, ">", 0))

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

Astuce : La ligne d'instruction Données = DataAddData(Données, Tps, Array(3, ">", 0)) n'est pas évidente à comprendre, car elle reprend deux variables numériques dans sa partie Array(3, ">", 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 Données = DataAddData(Données, Tps, Array("C3", ">", 0)) et peut se lire plus facilement par : Colonne 3 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 commencent 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 Données = DataAddData(Données, Tps) peut être remplacée par son équivalent en déclarant le nom des arguments utilisés :
Données = DataAddData(DataTable:=Données, DataTableAdd:=Tps)

Tout dépend de vos habitudes de programmation.

II-C - DataRemove - Supprimer des éléments

Les données chargées dans la mémoire « Données » incluent 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 DataRemove.

Ses arguments sont :

- DataTable : La mémoire 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).

La fonction renvoie le nombre d'éléments supprimés.

Et donc pour supprimer les notes qui valent 0 (c’est-à-dire la colonne 3 vaut 0) :
Call DataRemove(Données, Array("C3", "=", 0), True)

- L'argument MatchCase étant à True par défaut, il n'était pas nécessaire de le renseigner dans cet exemple.

- Et la fonction ne renvoyant rien d'utilisé, il était possible de l'appeler par :
DataRemove Données, Array("C3", "=", 0)

Ici aussi vous adapterez les codes présentés à vos habitudes de programmation.

Astuce : Utilisez la fonction DataRemoveItem pour supprimer un élément d'après sa position dans la mémoire.

II-D - DataSort - Trier les données

La fonction DataSort trie (par ordre croissant ou décroissant) un tableau de données sur une ou plusieurs de ses colonnes.

Ses arguments sont :

- DataTable : La mémoire qui contient les données ;

- ArrayColumns : Les colonnes (en Array) sur lesquelles porte le tri (si la colonne est préfixée « < » alors trie par ordre décroissant) ;

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

- ToReturn : (facultatif) Si renseigné, alors alimente directement la mémoire passée en argument, ce qui fait gagner du temps de traitement.

La fonction renvoie un tableau de données en base 1 qui contient les données triées.

Nous allons ainsi trier par ordre croissant la mémoire « Données » sur les noms, prénoms et dates :
Données = DataSort(Données, Array("C1", "C2", "C4"), True)
Cela sera nécessaire pour la restitution du détail lorsqu’un élève est sélectionné.

Astuce : Vous pouvez inverser l’ordre d'une mémoire avec la fonction DataReverse.

Vous trouverez en annexe 2 plus d'informations sur l'algorithme de tri utilisé qui respecte l'ordre d'origine des données lorsqu'il y a des égalités (on parle alors d'un tri stable), comme le fait Excel alors que l'algorithme Quick Sort n'en est pas capable.

Astuce : Gagnez du temps de traitement en passant en argument ToReturn la mémoire qui doit contenir le tri.
Par exemple : Call DataSort(Données, "C1", True, Tri)
Au lieu de : Tri = DataSort(Données, "C1", True)

II-E - DataFromData - Copier certaines colonnes

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

Les arguments de la fonction DataFromData sont :

- DataTable : La mémoire qui contient les données ;

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

La fonction renvoie un tableau de données en base 1 qui contient les données chargées.

Ici nous copions les colonnes 1 et 2 de « Données » dans « Synthese »  :
Synthese = DataFromData(Données, Array("C1", "C2"))

Pour faire une copie intégrale d'une mémoire, utilisez tout simplement l'opérateur égal :
Dim Data
Data = Données

II-F - DataUnique - Générer une liste unique

Nous pouvons maintenant générer un tableau de données sans doublon pour la synthèse des élèves à partir de la mémoire « Synthese » qui ne contient que deux colonnes, pour les noms et prénoms.
La fonction DataUnique réalise cela.

Ses arguments sont :

- DataTable : La mémoire qui contient les données ;

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

La fonction renvoie un tableau de données en base 1 qui contient les données sans doublon classées par ordre croissant.

La mémoire « Synthese » est transformée en une liste unique, triée par ordre croissant :
Synthese = DataUnique(Synthese, True)

II-G - DataAddColumns - Ajouter (ou supprimer) des colonnes

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

Ses arguments sont :

- DataTable : La mémoire qui contient les données ;

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

La fonction renvoie un tableau de données en base 1 qui correspond à DataTable avec plus ou moins de colonnes selon ce qui est demandé dans l'argument Columns.

Ajout de trois colonnes au tableau de données « Synthese » :
Synthese = DataAddColumns(Synthese, 3)

Si l'argument DataTable est une mémoire à une seule dimension, déclarée par Dim Data(1 To n), alors la fonction la transforme en un tableau de données de la forme Data(1 To y, 1 To x) comme expliqué dans l'introduction.

II-H - DataCount - Compter le nombre d’éléments

Dans le tableau de données « Synthese », pour alimenter la colonne du nombre des notes pour chaque élève, nous allons lire toutes les lignes (nous verrons plus loin comment faire cette boucle) et pour chacune compter le nombre d’éléments dans « Données » qui correspondent au nom et prénom de l'élève.
La fonction DataCount renvoie le nombre d’éléments qui correspondent aux critères demandés.

Ses arguments sont :

- DataTable : La mémoire 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 mémoire passée dans l'argument DataTable 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 un entier long représentant le nombre d'éléments correspondant aux critères d'analyse désirés.

Soit pour chaque ligne « i », il faut compter combien de fois l’on retrouve dans la mémoire « Données » en colonne 1 son nom, correspondant à « Synthese(i, 1) », et en colonne 2 son prénom, correspondant à « Synthese(i, 2) » :
Nb = DataCount(Données, Array("C1", "=", Synthese(i, 1), "C2", "=", Synthese(i, 2)), True, True)

Astuce : Dans notre cas la mémoire « 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 mémoire, 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 le tableau de données source et de procéder ainsi, car vous gagnerez énormément en temps de traitement.

Astuce : Pour faire une boucle de la première à la dernière ligne de la mémoire « Synthese », vous pouvez utiliser l'instruction Ubound(Synthese) pour connaitre le nombre de lignes de la mémoire, ou la fonction DataSize qui fait la même chose :
For i = 1 to DataSize(Synthese)
...
Next i

II-I - DataSum - 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 DataSum.

Ses arguments sont :

- DataTable : La mémoire 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 mémoire passée dans l'argument DataTable 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 un numérique de type Double qui est la somme de la colonne passée en argument correspondant aux critères d'analyse désirés.

Soit pour chaque ligne « i » de « Synthese », sachant que les noms sont en colonne 1 et les prénoms en colonne 2 dans les deux mémoires, et que les notes sont en colonne 3 dans « Données » :
Somme = DataSum(Données, "C3", Array("C1", "=", Synthese(i, 1), "C2", "=", Synthese(i, 2)), True, True)

II-J - DataUpdateItem - 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 3 et 4, du tableau de données « Synthese », avec la fonction DataUpdateItem.

Ses arguments sont :

- DataTable : La mémoire qui contient les données ;

- 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.

La fonction renvoie True si tout s'est bien passé, False dans le cas contraire.

Soit pour chaque ligne « i », pour remplacer la note en colonne 3 dans « Synthese » par la valeur « Nb » retrouvée :
Call DataUpdateItem(Synthese, "C3", "=", Nb, i)

Et pour remplacer la moyenne en colonne 4 (avec une précision d’un chiffre après la virgule) :
Call DataUpdateItem(Synthese, "C4", "=", Round(Somme / Nb, 1), i)

Il est possible aussi de modifier directement les mémoires par ces instructions :
Synthese(i, 3) = Nb
Synthese(i, 4) = Round(Somme / Nb, 1)

Inversement, pour connaitre le contenu d'une mémoire vous pouvez :
- soit faire un appel direct : Nb = Synthese(i, 3)
- soit utiliser la fonction DataValue : Nb = DataValue(Synthese, "C3", i)

Astuce : La fonction DataUpdateAll met à jour tout un tableau de données suivant un critère d'analyse, sans avoir besoin de faire une boucle sur ses lignes.
En plus des quatre premiers arguments de DataUpdateItem, cette fonction en comporte trois autres déjà présentés plusieurs fois : « ArrayColumnCompareValue », « MatchCase » et « Sorted ».
Par exemple pour ajouter 1 point aux notes inférieures à 10 dans « Données » :
Call DataUpdateAll(Données, "C3", "+", 1, Array("C3", "<", 10))

II-K - DataRank – Obtenir l'ordre de classement

Nous avons enregistré la moyenne des notes dans la mémoire « Synthese ». Cela nous permet de définir l'ordre de classement des élèves. De celui qui a la plus forte moyenne, classé premier, a celui qui à la plus faible, classé sixième.

La fonction DataRank a les arguments suivants :

- DataTable : La mémoire qui contient les données ;

- Column : La colonne dont il faut analyser l'ordre de classement, en principe elle ne contient que des données numériques
Si la colonne est préfixée « = », alors le même rang est attribué pour les égalités.
Si la colonne est préfixée « < », alors l'ordre de classement (qui est croissant par défaut) est inversé.

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

La fonction renvoie un tableau de données en base 1 qui contient l'ordre de classement des données.

Pour alimenter la colonne du classement dans le tableau de synthèse :

' Création du classement (même ordre pour les égalités) d'après la moyenne en colonne 4:
Dim Classement
Classement = DataRank(Synthese, "<=C4")

' Boucle sur les élèves dans le tableau de synthèse pour actualiser le classement en colonne 5:
For i = 1 To DataSize(Synthese)
Synthese(i, 5) = Classement(i)
Next i

Notez que la colonne est préfixée « <= », car nous souhaitons attribuer le même rang aux élèves qui ont la même moyenne, et qu'il faut inverser l'ordre de classement qui par défaut est croissant, car la meilleure moyenne est celle qui est la plus élevée et non l'inverse.

II-L - DataToTable – 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 mémoire « Synthese ».

La fonction DataToTable a les arguments suivants :

- DataTable : La mémoire qui contient les données ;

- TS : Le tableau structuré à renseigner.

- Action : L’action à effectuer suivant l'énumération Enum_DataToTable
DataToTable_Replace : Remplace les données existantes,
DataToTable_Add : Ajoute les données aux données existantes,
Les colonnes non renseignées sont vides, les colonnes en plus sont ignorées.

La fonction renvoie True si tout s'est bien passé, False dans le cas contraire.

Pour alimenter la synthèse en remplaçant les données existantes :
Call DataToTable(Synthese, [TS_Synthese], DataToTable_Replace)

Notez que [TS_Synthese] est équivalent à Range("TS_Synthese").

Plus d'informations pour gérer les tableaux structurés dans cette documentation : Fonctions en VBA pour gérer les Tableaux Structurés d’Excel.

II-M - DataIndexOf - 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 (sa ligne) dans la liste « Synthese ».

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

- DataTable : La mémoire 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 mémoire passée dans l'argument DataTable 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 le tableau de données 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 = DataIndexOf(Synthese, Array("C1", "=", "TERRIEUR", "C2", "=", "Alain"))
Puis la moyenne par :
Moyenne = Synthese(i, 4)

II-N - DataContains - 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 DataContains, ses arguments sont :

- DataTable : La mémoire 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 mémoire passée dans l'argument DataTable 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 DataContains(Synthese, Array("C4", ">=", 15)) renvoie True.

II-O - DataAddItem - 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 DataAddItem.

Ses arguments sont :

- DataTable : La mémoire 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 l'élément à modifier, vide ou 0 pour l’ajouter à la suite de la liste.

Par exemple pour ajouter un nouvel élève :
Call DataAddItem(Synthese, Array("AIMAR", "Jean"))

Et pour insérer un élève en première position :
Call DataAddItem(Synthese, Array("AIMAR", "Jean"), 1)

Remarque : les colonnes non renseignées prennent la valeur « vide ».

III - Le code source de l’exercice

Voici le code intégral de l’exercice :

Public Données

'----------------------------------------------------------------------------------------
Dim i As Long
Dim Tps As Variant, Synthese As Variant
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 "Données" (qui est publique, car on s'en servira
' par la suite lors d'un événement sur le tableau de synthèse):
Données = DataFromRange(Range("Tableau1"), Array("C1", "C2", "C3", "C4", "C5"))
' 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):
Tps = DataFromRange(Sheets("Feuil5").Range("A1"), Array("C1", "C2", "C3", "C5", "C4"))
' Concatène les deux listes dans "Données":
Données = DataAddData(DataTable:=Données, DataTableAdd:=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):
Tps = DataFromRange(Sheets("Feuil6").Range("A2"))
' Concatène les deux listes dans "Données":
Données = DataAddData(Données, Tps)

' Supprime les notes à 0 (c'est-à-dire 0 est dans la 3è colonne):
Call DataRemove(Données, Array("C3", "=", 0), True)

' Trie la liste par nom, prénom, date:
Données = DataSort(Données, Array("C1", "C2", "C4"), True)

' Charge uniquement les noms et prénoms (pour alimenter la synthèse):
Synthese = DataFromData(Données, Array("C1", "C2"))

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

' Ajoute trois colonnes (pour contenir par la suite le nombre de notes, la moyenne et le classement)
' à cette liste qui servira de synthèse:
Synthese = DataAddColumns(Synthese, 3)

' Boucle sur les éléments de Synthese pour actualiser le nombre de notes et la moyenne:
For i = 1 To DataSize(Synthese)
' Recherche le nombre de notes pour le nom + prénom dans la liste source triée:
Nb = DataCount(Données, Array("C1", "=", Synthese(i, 1), "C2", "=", Synthese(i, 2)), True, True)
' Mise à jour de la colonne Nb (3è colonne en base 1) pour l'élément i dans la liste de synthèse:
Call DataUpdateItem(Synthese, "C3", "=", Nb, i)
' Recherche la somme des notes pour le nom + prénom dans la liste source triée:
Somme = DataSum(Données, "C3", Array("C1", "=", Synthese(i, 1), "C2", "=", Synthese(i, 2)), True, True)
' Mise à jour de la colonne Moyenne (4è colonne en base 1) pour l'élément i dans la liste de synthèse:
Call DataUpdateItem(Synthese, "C4", "=", Round(Somme / Nb, 1), i)
Next i

' Création du classement (même ordre pour les égalités) d'après la moyenne en colonne 4:
Dim Classement
Classement = DataRank(Synthese, "<=C4")

' Boucle sur les élèves dans le tableau de synthèse pour actualiser le classement:
For i = 1 To DataSize(Synthese)
Synthese(i, 5) = Classement(i)
Next i

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

' Prépare le tableau de détail TS_Données:
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 DataSize(Données) > 0 Then
Dim List As Variant
List = DataAddData(List, Données, Array("C1", "=", Nom, "C2", "=", Prénom))
' Affiche la liste dans le tableau structuré TS_Données:
If DataSize(List) > 0 Then Call DataToTable(List, [TS_Données], DataToTable_Replace)
End If
End If

End If

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

IV - DataFromSQL - Exécuter une requête SQL

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 mémoire « 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 tableau de données.
Sauf si l’on triche un peu... et sous réserve que les données ne dépassent pas la capacité d'une feuille de calcul d'Excel.
Il suffit de reverser les données de la mémoire sur une feuille de calcul provisoire, d’y ajouter une ligne d’en-tête de colonne (nommés arbitrairement C1, C2, C3, etc.), d’exécuter une requête SQL, de récupérer le jeu d’enregistrements obtenu pour le placer dans une nouvelle mémoire, et enfin de supprimer la feuille provisoire.

La fonction DataFRomSQL a les arguments suivants :

- DataTable : La mémoire qui contient les données ;

- Fields : Les champs à sélectionner ;

- StrSQL : L’instruction en SQL.

La fonction renvoie un tableau de données en base 1 qui répond à la requête SQL, ou Nothing.

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 ligne :
Synthese = DataFromSQL(Données, "C1, C2, Count(C3), AVG(C3)", "GROUP BY C1, C2 ORDER BY C1, C2")

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 1 et préfixés par « C », qui correspondent donc à la dimension du tableau de données.
La première colonne est désignée « C1 », la suivante « C2 » 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 :

- GROUP 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 DataFRomSQL 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 mémoire « Données » contient les données de trois tableaux fusionnés et « 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 à « Données » qui contiendra l'indexation des éléments (vous allez comprendre pourquoi ci-dessous).
- Boucler sur les élèves de la liste « Synthese » et si la moyenne (colonne 4) est inférieure à 10 alors :
- Faire une requête SQL pour récupérer dans une mémoire temporaire les notes inférieures à 10 de l'élève identifié par son nom (colonne 1) et son prénom (colonne 2).
- Pour chaque ligne de la liste obtenue :
- Récupérer l'indexation de l'évaluation contenue dans la colonne 6.
- Ajouter 2 points à la note (colonne 3) dans la limite de 10.
- Mettre à jour l'élément dans « Données » puisque l'on connait sa position (par l'indexation).
- Supprimer la colonne d'indexation dans « 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 mémoire Données:
Données = DataAddColumns(Données, 1)
For i = 1 To DataSize(Données)
Données(i, 6) = i
Next i

' Boucle sur chaque ligne de la mémoire Synthese:
For Eleve = 1 To DataSize(Synthese)
' Si la moyenne est < 10:
If Synthese(Eleve, 4) < 10 Then
' Requête SQL pour obtenir les notes < 10 de l'élève:
Rt = DataFromSQL(Données, "*", "WHERE C3 < 10 AND C1 = '" & Synthese(Eleve, 1) & "' AND C2 = '" & Synthese(Eleve, 2) & "'")
' Boucle sur chaque note:
For E = 1 To DataSize(Rt)
' Récupère l'indexe de l'évaluation:
i = Rt(E, 6)
' Ajouter 2 points à la note sans dépasser 10:
Note = Rt(E, 3) + 2
If Note > 10 Then Note = 10
' Mise à jour de la note dans la mémoire Données
Données(i, 3) = Note
Next E
End If
Next Eleve

' Supprime de la mémoire Données l'indexation:
Données = DataAddColumns(Données, -1)
' Actualise le tableau de synthèse:
Synthese = DataFromSQL(Données, "C1, C2, Count(C3), AVG(C3)", "GROUP BY C1, C2 ORDER BY C1, C2")
' Et l'affiche:
Call DataToTable(Synthese, [TS_Synthese], DataToTable_Replace)

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é CP_Synthese par la requête SQL

Dim Données

Données = DataFromRange([TS_CP])
Données = DataFromSQL(Données, "TOP 5 C5, C7, C4, Count(C5)", "WHERE C5>'' GROUP BY C5, C4, C7 ORDER BY Count(C5) DESC")
Call DataToTable(Données, [CP_Synthese], DataToTable_Replace)

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 volumineuses dépassant les capacités d'une feuille de calcul d'Excel.

Je suis bien conscient que vous obtenez le même résultat avec d’autres techniques de programmation (ou en découpant vos données en plusieurs paquets) 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 « DataXXL » 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.
2025.

VI - Remerciements

Je remercie User pour sa relecture, ses apports et ses conseils, et f-leb pour sa correction orthographique.
Ainsi que toute l’équipe de Developpez.com qui participe à la maintenance du site.

VII - Le fichier joint

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

VIII - Annexe 1 : Liste des fonctions

Liste des fonctions publiques pour gérer de gros volumes de données

IX - Annexe 2 : L'algorithme de classement Quick Rank

La fonction DataSort n’utilise pas le célèbre algorithme de tri rapide Quick Sort inventé par Charles Antony Richard Hoare, car cet algorithme à l’inconvénient de ne pas conserver l’ordre d’origine des données lorsqu’il y a des égalités, contrairement à ce que fait Excel.

Conserver l’ordre d’origine des données (soit un tri dit « stable ») est bien pratique pour faire un tri sur plusieurs colonnes, par exemple pour trier par nom de famille et prénom.

C'est pourquoi j’ai développé l’algorithme de tri stable que j'ai nommée « Quick Rank ».

Son principe de base est de ne pas déplacer les données, mais d’indiquer dans une mémoire la position de l’élément supérieur suivant (soit une liste chaînée). Bien entendu, l’insertion d’un élément nécessite la mise à jour de cette indexation.

Pour reconstituer un tri croissant, il convient de partir de l’élément le plus petit, puis de passer à la position de l’élément suivant, ainsi de suite jusqu’à la fin de la liste.

Pour un meilleur temps de traitement lorsqu’il y a des égalités, une première amélioration consiste à mémoriser également la position du prochain élément supérieur différent. Cela permet alors de sauter tous les éléments égaux pour se retrouver directement à la position désirée.

Mais impossible de rivaliser avec Quick Sort sans une amélioration décisive qui consiste à gérer parallèlement une liste sans doublon des éléments déjà triés, qui permet via une recherche dichotomique d’atteindre rapidement l’élément le plus proche de la position recherchée.

Au final Quick Rank n’est pas ridicule face à Quick Sort pour trier une liste idéalement aléatoire, là ou Quick Sort excelle, et est particulièrement efface sur les listes partiellement triées ou comportant de nombreuses égalités (cas souvent rencontré en pratique), tout en conservant l’ordre d’origine des données.

Voyons cela avec un exemple de nombres à trier...

Étape d'initialisation d'après les deux premières valeurs :
Identification du minimum (en vert) et du maximum (en orange), le suivant du minimum (15) est l'indice 2.
Le suivant du maximum (75) n'existe pas, il est noté -1.

Analyse de l'indice 3 qui vaut 20.
Le suivant du minimum, l'indice 2 vaut 75. C'est plus grand que la valeur à classer qui vaut 20, donc le suivant du minimum devient l'indice 3 et le suivant de l'indice 3 est l'ancien suivant du minimum = 2.
Les flèches représentent le sens de la lecture des indices pour avoir l'ordre de classement de ces trois éléments, en partant du minimum.

Analyse de l'indice 4 qui vaut 18.
Le suivant du minimum, l'indice 3 vaut 20. C'est plus grand que la valeur à classer qui vaut 18, donc le suivant du minimum devient l'indice 4 et le suivant de l'indice 4 est l'ancien suivant du minimum = 3.

Analyse de l'indice 5 qui vaut 20.
Le suivant du minimum, l'indice 4 vaut 18. Donc on continue la lecture jusqu'à atteindre une valeur plus grande que 20. Soit son suivant, l'indice 3 qui vaut 20, puis son suivant, l'indice 2 qui vaut 75.
On a atteint un plus grand donc le suivant de l'indice 5 est 2. Et on met à jour le dernier indice analysé, l'indice 3, pour indiquer que son suivant est l'indice 5.
En partant du minimum (à l'indice 1) on lit les indices 4, puis 3, puis 5, puis 2.

Analyse de l'indice 6 qui vaut 5.
C'est un nouveau minimum donc son suivant est l'indice de l'ancien minimum = 1.

Analyse de l'indice 7 qui vaut 99.
C'est un nouveau maximum. Donc on met à jour l'ancien maximum, l'indice 2, pour indiquer que son suivant est l'indice 7. Le suivant du nouveau maximum est -1.

Analyse de l'indice 8 qui vaut 5.
Comme d'habitude, on part du minimum en lisant les indices suivants pour trouver une valeur plus grande que 5.
Et on met à jour le dernier indice lu pour indiquer que son suivant est l'indice 8, et le suivant de l'indice 8 est l'ancien suivant du dernier indice lu.

Analyse de l'indice 9 qui vaut 99.
La valeur est égale au maximum. L'indice devient le nouveau maximum donc son indice suivant est -1. Et on met à jour l'indice suivant de l'ancien maximum qui devient l'indice 9.

Analyse de l'indice 10 qui vaut 20.
Comme d'habitude, on part du minimum en lisant les indices suivants pour trouver une valeur plus grande que 20.
La lecture des indices et de leur valeur donne : 6 (5) -> 8 (5) -> 1 (15) -> 4 (18) -> 3 (20) -> 5 (20) -> 2 (75).
Et on met à jour le dernier indice lu pour indiquer que son suivant est l'indice 10 et le suivant de l'indice 10 est l'ancien suivant du dernier indice lu.

Analyse de l'indice 11 qui vaut 20.
La lecture des indices et de leur valeur donne : 6 (5) -> 8 (5) -> 1 (15) -> 4 (18) -> 3 (20) -> 5 (20) -> 10 (20) -> 2 (75).
Et on met à jour le dernier indice lu (10) pour indiquer que son suivant est l'indice 11 et le suivant de l'indice 11 est l'ancien suivant du dernier indice lu = 2.

UN COUP DE POUCE

Sur le même principe, on ajoute une mémoire annexe qui contient l'indice du dernier élément de même valeur.
La lecture des indices pour avoir l'ordre de classement est identique mais l'indice du « dernier égal » permet de trouver plus rapidement l'indice de l'élément dont la valeur est supérieure lorsqu'il y a plusieurs éléments de même valeur. Comme dans le dernier exemple que nous venons de voir où la valeur 20 est présente plusieurs fois.

Reprenons nos exemples en ajoutant la connaissance de l'indice du dernier élément de valeur égale :

Analyse de l'indice 3 qui vaut 20.
Lecture de l'indice suivant du dernier égal : 1=2 (75).

Analyse de l'indice 4 puis de l'indice 5 :

Analyse de l'indice 6 qui vaut 20 également :
Lecture de l'indice suivant du dernier égal : 1=4 (18) -> 4=3 (20) -> 5=2 (75).

Analyse de l'indice 12 qui vaut 88 :
Lecture de l'indice suivant du dernier égal : 8=1 (15) -> 1=4 (18) -> 4=3 (20) -> 11=2 (75) -> 2=7 (99).
À la lecture, on saute donc plusieurs étapes puisque l'on se branche directement de l'indice 3 à l'indice 2 sans avoir à passer par les indices 5, 6, 10 et 11.

Astuce : La lecture de l'indice suivant du dernier égal donne une liste sans doublon.

AMÉLIORATION : RECHERCHE DICHOTOMIQUE

Reprenons le dernier classement analysé, avec l'ajout du coup de pouce :

Lecture de l'indice suivant du dernier égal : 8=1 (15) -> 1=4 (18) -> 4=3 (20) -> 11=2 (75) -> 2=7 (99).

On obtient une liste sans doublon de 6 éléments :

Pour ajouter dans la liste à classer un nouvel élément qui vaut 88, une recherche dichotomique dans cette liste sans doublon donne rapidement que la plus proche valeur inférieure ou égale à 88 est 75, soit l'indice 2.
L'analyse part donc directement de l'indice 2 pour trouver un élément dont la valeur est supérieure à 88.

Lecture de l'indice suivant du dernier égal : 2=7 (99).

L'avantage procuré par la recherche dichotomique est plus flagrant sur une grande liste à trier.
La liste sans doublon ne sera actualisée que de temps en temps, car elle consomme des ressources. Il faut donc trouver le juste équilibre entre le gain qu'elle apporte et le temps qu'elle prend à être générée.

Un pseudo code au format « pdf » : QuickRank.pdf.

Le module « QuickSort » du fichier joint présente une version personnalisée de l'algorithme QuickSort rendu stable, ce qui nécessite des traitements supplémentaires, et donc ne le rend pas aussi rapide que QuickRank (tests réalisés en VBA, un langage de programmation différent peut obtenir d'autres résultats).

X - Annexe 3 : 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 Enum Enum_DataToTable
DataToTable_Add
DataToTable_Replace
End Enum

'----------------------------------------------------------------------------------------
Public Function DataFromRange(Rg As Range, Optional ByVal ArrayColumns As Variant = "") As Variant
'----------------------------------------------------------------------------------------
' 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 certaines, et renvoie un tableau de données.
'----------------------------------------------------------------------------------------
' 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
' 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 tableau de données en base 1 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

' Force l'argument en type Array:
If IsArray(ArrayColumns) = False Then ArrayColumns = Array(ArrayColumns)

' Si la plage source est un tableau structuré:
If Not Rg.ListObject Is Nothing Then
' S'il faut tout reprendre:
If ArrayColumns(0) = "" Then
DataFromRange = Rg.ListObject.DataBodyRange.Value
GoTo Gest_Err
End If
' Sinon mémoriser les données:
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
' S'il faut tout reprendre et qu'il n'y a pas d'en-tête:
If ArrayColumns(0) = "" And z = 0 Then
DataFromRange = Rg.CurrentRegion.Value
GoTo Gest_Err
End If
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

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

' Dimensionne une mémoire pour reprendre les données d'une ligne:
Dim List() As Variant
ReDim List(1 To UBound(Data) - z, 1 To NbColonne)

' Boucle sur les lignes:
For i = 1 + z To UBound(Data)
' Boucle sur les colonnes à reprendre:
For K = 1 To NbColonne
List(i - z, K) = Data(i, Colonne(K))
Next K
Next i

' Renvoie le tableau de données avec les données chargées:
DataFromRange = List

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

End Function

'----------------------------------------------------------------------------------------
Public Function DataFromData(DataTable As Variant, Optional ByVal ArrayColumns As Variant = "") As Variant
'----------------------------------------------------------------------------------------
' Charge les données d'un tableau de données, en reprenant toutes ses colonnes ou certaines,
' et renvoie un autre tableau.
'----------------------------------------------------------------------------------------
' DataTable : Le tableau de données en base 1 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 tableau de données en base 1 qui contient les données chargées.
'----------------------------------------------------------------------------------------
Dim i As Long, K As Integer
Dim NbColonne As Integer
Dim Colonne As Variant

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

' Force l'argument en type Array:
If IsArray(ArrayColumns) = False Then ArrayColumns = Array(ArrayColumns)

' S'il faut tout reprendre alors clone le tableau de données source:
If ArrayColumns(0) = "" Then
DataFromData = DataTable
GoTo Gest_Err
Else ' S'il faut respecter la limitation indiquée:
NbColonne = UBound(ArrayColumns) + 1
ReDim Colonne(1 To NbColonne)
For i = 1 To NbColonne
Colonne(i) = VbValue(ArrayColumns(i - 1))
Next i
End If

' Dimensionne une mémoire pour reprendre les données d'une ligne:
ReDim DataTableTps(1 To UBound(DataTable), 1 To NbColonne) As Variant

' Boucle sur les éléments:
For i = 1 To UBound(DataTable)
' Boucle sur les colonnes à reprendre:
For K = 1 To NbColonne
DataTableTps(i, K) = DataTable(i, Colonne(K))
Next K
Next i

' Renvoie le tableau de données avec les données chargées:
DataFromData = DataTableTps

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

End Function

'------------------------------------------------------------------------------------------------
Public Function DataFromTxt(ByVal FileFullPath As String, Header As Boolean, _
Optional Delimiter As Variant = vbTab) As Variant
'------------------------------------------------------------------------------------------------
' Alimente un tableau de données en base 1 depuis un fichier texte (au format français).
' Délimiteur = Tabulation (par défaut), Dates = jour/mois/Année, Séparateur numérique = virgule.
'------------------------------------------------------------------------------------------------
' FileFullPath : Le fichier CSV, avec son chemin, son nom complet y compris l'extension.
' Header : True si le fichier à une ligne d'en-tête (qu'il faudra ignorer).
' Delimiter : Le délimiteur qui identifie les champs dans le fichier texte.
'------------------------------------------------------------------------------------------------
' Renvoie : Un tableau de données en base 1 qui contient les données chargées.
'------------------------------------------------------------------------------------------------
Dim NumFichier As Long, Taille As Long, i As Long, j As Integer, Début As Integer
Dim Text As String
Dim Textlines As Variant, V As Variant, K As Long

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

' 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

' Gestion de la ligne d'en-tête:
If Header = True Then Début = 1
' Récupère le nombre de colonnes:
V = Split(Textlines(0), Delimiter)
' Dimensionne la variable destination:
ReDim Data(1 To UBound(Textlines) - Début, 1 To UBound(V) + 1)

' Boucle sur les lignes du fichier pour les charger en mémoire:
For i = Début To UBound(Textlines)
V = Split(Textlines(i), Delimiter)
K = K + 1
For j = 0 To UBound(V)
Data(K, j + 1) = V(j)
Next j
Next i

' Renvoie le tableau de données en base 1:
DataFromTxt = Data

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

End Function

'------------------------------------------------------------------------------------------------
Public Function DataFromSQL(DataTable As Variant, Fields As String, ByVal StrSQL As String) As Variant
'------------------------------------------------------------------------------------------------
' Exécute une requête SQL de type SELECT sur un tableau de données, sous réserve que le tableau
' fasse moins de 1048876 lignes.
'------------------------------------------------------------------------------------------------
' DataTable : Le tableau de données en base 1 qui contient les données.
' Fields : Les champs de la liste à sélectionner (référencés de C1 à Cn), ou "*" pour tout prendre.
' StrSQL : La requête SQL.
'------------------------------------------------------------------------------------------------
' Renvoie : Un tableau de données en base 1 qui répond à la requête SQL, ou Nothing.
'------------------------------------------------------------------------------------------------
' Exemple d'appel:
' Rt = DataFromSQL(DataTable, "C1, C2, Sum(C3)/Count(C3)", "WHERE C3>0 GROUP BY C1, C2 ORDER BY C1, C2")
'------------------------------------------------------------------------------------------------
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 DataFromSQL = Nothing

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

' Erreur si trop de lignes:
If UBound(DataTable) > Application.Rows.Count Then
Err.Raise vbObjectError, "DataToTable", "Trop de lignes à afficher"
End If

' Ajoute les colonnes d'en-tête:
For j = 1 To UBound(DataTable, 2)
Cells(1, j) = "C" & j
Next j

' Affiche les données:
Range("A2").Resize(UBound(DataTable, 1), UBound(DataTable, 2)).Value = DataTable

' 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 = UBound(DataTable)
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(DataTable, 2) + 1 To x + 1 Step -1
Columns(j).Delete
Next j
' Charge les données sélectionnées par la requête:
DataFromSQL = [A1].CurrentRegion
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, "DataFromSQL", Err.Description
Err.Clear

End Function

'----------------------------------------------------------------------------------------
Public Function DataAddData(DataTable As Variant, DataTableAdd As Variant, _
Optional ByVal ArrayColumnCompareValue As Variant = "", _
Optional MatchCase As Boolean = True) As Variant
'----------------------------------------------------------------------------------------
' Ajoute les éléments d'un tableau de données qui répondent aux critères de sélection
' passés en argument à un autre tableau de données.
'----------------------------------------------------------------------------------------
' DataTable : Le tableau de données en base 1 qui contient les données figées (peut être vide).
' DataTableAdd : Le tableau de données en base 1 qui contient les données à concaténer suivant
'                les critères de sélection des arguments ArrayColumnCompareValue et MatchCase.
' ArrayColumnCompareValue : Array des couples "Colonne", "Opérateur", "Valeur".
' MatchCase : True pour que l'analyse respecte la casse, False dans l'autre cas.
'----------------------------------------------------------------------------------------
' Renvoie : Un tableau de données en base 1 qui correspond à DataTable + les données de
'           DataTableAdd qui correspondent aux critères de sélection (vide pour tout reprendre).
'----------------------------------------------------------------------------------------
Dim i As Long, j As Integer, K As Long
Dim List As Variant
Dim Tps As Variant

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

' Force l'argument en type Array:
If IsArray(ArrayColumnCompareValue) = False Then ArrayColumnCompareValue = Array(ArrayColumnCompareValue)

' Boucle sur les données du tableau à reprendre:
Select Case ArrayColumnCompareValue(0)

Case Is = ""
List = DataTableAdd
K = DataSize(DataTableAdd)

Case Else
ReDim List(1 To UBound(DataTableAdd), 1 To UBound(DataTableAdd, 2))
For i = 1 To UBound(DataTableAdd)
For j = 0 To UBound(ArrayColumnCompareValue) Step 3
ArrayColumnCompareValue(j) = VbValue(ArrayColumnCompareValue(j))
If VbCompare(DataTableAdd(i, ArrayColumnCompareValue(j)), ArrayColumnCompareValue(j + 1), ArrayColumnCompareValue(j + 2), MatchCase) = False Then Exit For
Next j
If j > UBound(ArrayColumnCompareValue) Then
K = K + 1
For j = 1 To UBound(DataTableAdd, 2)
List(K, j) = DataTableAdd(i, j)
Next j
End If
Next i

End Select

' S'il y a données à concaténer:
If K > 0 Then

ReDim Tps(1 To DataSize(DataTable) + K, 1 To UBound(DataTableAdd, 2))

' Récupère les données de DataTable:
For i = 1 To DataSize(DataTable)
For j = 1 To UBound(DataTable, 2): Tps(i, j) = DataTable(i, j): Next j
Next i

' Y ajoute les données de List:
For K = 1 To K
For j = 1 To UBound(List, 2): Tps(i, j) = List(K, j): Next j
i = i + 1
Next K

' Renvoie le tableau:
DataAddData = Tps

Else

' S'il n'y a pas de données à concaténer:
DataAddData = DataTable

End If

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

End Function

'----------------------------------------------------------------------------------------
Public Function DataAddColumns(DataTable As Variant, Columns As Integer) As Variant
'----------------------------------------------------------------------------------------
' Ajoute ou supprime des colonnes à un tableau de données.
'----------------------------------------------------------------------------------------
' DataTable : Le tableau de données en base 1 qui sera modifié.
' Columns : Le nombre de colonnes à ajouter, ou à supprimer si Columns est négatif.
'----------------------------------------------------------------------------------------
' Renvoie : Un tableau de données en base 1 qui correspond à DataTable avec plus ou moins
'           de colonnes selon ce qui est demandé dans l'argument Columns.
'----------------------------------------------------------------------------------------
Dim Nb As Integer
Dim i As Long, j As Integer
Dim Tps As Variant

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

' Copie le tableau d'origine dans un tableau provisoire:
Tps = DataTable

' Calcule le nouveau nombre de colonnes:
On Error Resume Next
Nb = UBound(Tps, 2)
On Error GoTo Gest_Err

Select Case Nb

' Ajout ou suppression des colonnes:
Case Is > 0
Nb = UBound(Tps, 2) + Columns
If Nb < 1 Then Nb = 1
ReDim Preserve Tps(1 To UBound(Tps), 1 To Nb)

' Si DataTable n'a qu'une dimension alors création d'une variable
' à plusieurs dimensions:
Case Else
ReDim Tps(1 To UBound(DataTable), 1 To Columns)
For i = 1 To UBound(DataTable)
Tps(i, 1) = DataTable(i)
Next i

End Select

' Renvoie le tableau de données:
DataAddColumns = Tps

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

End Function

'----------------------------------------------------------------------------------------
Public Function DataToTable(DataTable As Variant, TS As Range, Action As Enum_DataToTable) As Boolean
'----------------------------------------------------------------------------------------
' Alimente un tableau structuré d'un tableau de données, soit en y remplaçant les
' donnnées existantes soit en y ajoutant les nouvelles données.
'----------------------------------------------------------------------------------------
' DataTable : Le tableau de données en base 1 qui contient les données sources.
' TS : Le tableau structuré.
' Action, suivant l'énumération Enum_DataToTable :
'   DataToTable_Replace : Remplace les données existantes.
'   DataToTable_Add : Ajoute les données aux données existantes.
' 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.
'----------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Erreur si trop de lignes:
If UBound(DataTable) > Application.Rows.Count Then
Err.Raise vbObjectError, "DataToTable", "Trop de lignes à afficher"
End If

' 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

' Détermine le nombre de colonnes:
Dim NbColonne As Integer
NbColonne = UBound(DataTable, 2)
If NbColonne > TS.ListObject.ListColumns.Count Then NbColonne = TS.ListObject.ListColumns.Count

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

Case DataToTable_Replace ' Remplace les données:
If UBound(DataTable) < TS.ListObject.ListRows.Count Then ' Efface les lignes en trop.
TS.ListObject.DataBodyRange.Rows(UBound(DataTable) + 1 & ":" & TS.ListObject.ListRows.Count).Delete
End If
' Efface le tableau structuré:
TS.ListObject.DataBodyRange.Clear
' Pose les données mémorisées:
TS.Cells(1, 1).Resize(UBound(DataTable), NbColonne).FormulaLocal = DataTable

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

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

End Select

' Renvoie Vrai:
DataToTable = True

' Fin du traitement:
Gest_Err:

If Err.Number <> 0 Then
Err.Raise Err.Number, "DataToTable", Err.Description
End If
Err.Clear

End Function

'----------------------------------------------------------------------------------------
Public Function DataIndexOf(DataTable As Variant, _
ByVal ArrayColumnCompareValue As Variant, _
Optional MatchCase As Boolean = True, _
Optional Sorted As Boolean = False) As Long
'----------------------------------------------------------------------------------------
' Renvoie la position (en base 1) d'un élément dans un tableau de données.
'----------------------------------------------------------------------------------------
' DataTable : Le tableau de données en base 1 qui contient les données.
' 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 1) dans le tableau de données 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

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

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

' Correction des noms de colonne:
For j = 0 To UBound(ArrayColumnCompareValue) Step 3
ArrayColumnCompareValue(j) = VbValue(ArrayColumnCompareValue(j))
Next j

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

' Boucle sur les données:
Dim V
For i = 1 To UBound(DataTable)
For j = 0 To UBound(ArrayColumnCompareValue) Step 3
V = DataTable(i, ArrayColumnCompareValue(j))
If VbCompare(V, ArrayColumnCompareValue(j + 1), ArrayColumnCompareValue(j + 2), MatchCase) = False Then Exit For
Next j
If j > UBound(ArrayColumnCompareValue) Then DataIndexOf = i: Exit For
Next i

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

End Function

'----------------------------------------------------------------------------------------
Public Function DataContains(DataTable As Variant, _
ByVal ArrayColumnCompareValue As Variant, _
Optional MatchCase As Boolean = True, _
Optional Sorted As Boolean = False) As Boolean
'----------------------------------------------------------------------------------------
' Indique si un élément dans un tableau de données est présent ou non.
'----------------------------------------------------------------------------------------
' DataTable : Le tableau de données en base 1 qui contient les données.
' 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:
DataContains = DataIndexOf(DataTable, ArrayColumnCompareValue, MatchCase) > -1

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

End Function

'----------------------------------------------------------------------------------------
Public Function DataValue(DataTable As Variant, _
ByVal Column As Variant, _
Item As Long) As Variant
'----------------------------------------------------------------------------------------
' Renvoie la valeur de la colonne dans un tableau de données pour l'élément demandé.
'----------------------------------------------------------------------------------------
' DataTable : Le tableau de données en base 1 qui contient les données.
' Column : La colonne concernée.
' Item : La position de l'élément concerné (en base 1).
'----------------------------------------------------------------------------------------
' Renvoie : La valeur trouvée.
'----------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Correction de la colonne:
Column = VbValue(Column)

' Renvoie la donnée:
DataValue = DataTable(Item, Column)

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

End Function

'----------------------------------------------------------------------------------------
Public Function DataSort(DataTable As Variant, _
ByVal ArrayColumns As Variant, _
Optional MatchCase As Boolean = True, _
Optional ToReturn As Variant) As Variant
'----------------------------------------------------------------------------------------
' Trie un tableau de données en respectant l'ordre d’origine lors des égalités.
'----------------------------------------------------------------------------------------
' DataTable : Le tableau de données en base 1 qui contient les données.
' 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.
' ToReturn : Si renseigné alors la variable sera alimentée directement, voir exemple.
'----------------------------------------------------------------------------------------
' Renvoie : Un tableau de données en base 1 trié.
'----------------------------------------------------------------------------------------
' Exemple d'appel pour trier la colonne 1 du tableau structuré nommé INSEE_2022:
'----------------------------------------------------------------------------------------
'Dim Données, Tri                        ' Initialisation des tableaux.
'Données = DataFromRange([INSEE_2022])   ' Charge les données depuis un tableau structuré.
'Call DataSort(Données, "C1", True, Tri) ' Alimente directement Tri (plus rapide).
'Tri = DataSort(Données, "C1")           ' Alimente Tri via le renvoi de la fonction.
'----------------------------------------------------------------------------------------
Dim j As Integer, Colonne As Integer
Dim Méthode As Byte

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

' Si une seule colonne à trier et qu'une variable est passée pour l'argument ToReturn,
' alors renseigne cette variable, car plus rapide que de renvoyer les données par la fonction:
If IsArray(ArrayColumns) = False And IsMissing(ToReturn) = False Then
Colonne = VbValue(ArrayColumns)
Méthode = IIf(Left(ArrayColumns, 1) = "<", 1, 0)
Call DataQR(DataTable, Colonne, Méthode, MatchCase, ToReturn)
Exit Function
End If

' Force l'argument en type Array:
If IsArray(ArrayColumns) = False Then ArrayColumns = Array(ArrayColumns)

' Copie les données d'origine dans un tableau temporaire:
Dim Rank
Dim TabDonnées
TabDonnées = DataTable

' Trie les données sur les différentes colonnes demandées:
For j = UBound(ArrayColumns) To 0 Step -1
Colonne = VbValue(ArrayColumns(j))
Méthode = IIf(Left(ArrayColumns(j), 1) = "<", 1, 0)
Call DataQR(TabDonnées, Colonne, Méthode, MatchCase, Rank)
TabDonnées = Rank
Next j

' Alimente ToReturn ou renvoie le tableau trié:
Select Case IsMissing(ToReturn)
Case False: ToReturn = TabDonnées
Case True: DataSort = TabDonnées
End Select

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

End Function

'----------------------------------------------------------------------------------------
Public Function DataRank(DataTable As Variant, Column As String, _
Optional MatchCase As Boolean = True) As Variant
'----------------------------------------------------------------------------------------
' Renvoie l'ordre de classement des éléments d'un tableau de données.
'----------------------------------------------------------------------------------------
' DataTable : Le tableau de données en base 1 qui contient les données.
' Column : La colonne dont il faut analyser l'ordre de classement des données.
'          Si la colonne est préfixée "=" alors renvoie l'ordre de classement des données
'          avec un même rang pour les égalités.
'          Si la colonne est préfixée "<" alors l'ordre est inversé.
' MatchCase : True pour que le classement respecte la casse, False dans l'autre cas.
'----------------------------------------------------------------------------------------
' Renvoie : Un tableau de type variant à une dimension en base 1.
'----------------------------------------------------------------------------------------
Dim Colonne As Integer
Dim Méthode As Byte
Dim Rank As Variant

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

Colonne = VbValue(Column)
Select Case Left(Column, 1)
Case "=": Méthode = 3
Case "<": Méthode = 4
Case Else: Méthode = 2
End Select
If Left(Column, 2) = "=<" Then Méthode = 5
If Left(Column, 2) = "<=" Then Méthode = 5

Call DataQR(DataTable, Colonne, Méthode, MatchCase, Rank)
DataRank = Rank

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

End Function

'----------------------------------------------------------------------------------------
Private Sub DataQR(TabDonnées As Variant, Colonne As Integer, _
ByVal Méthode As Byte, _
RespecterCasse As Boolean, _
Rank As Variant)
'----------------------------------------------------------------------------------------
' Trie les données passées dans TabDonnées et alimente Rank du résultat (c'est plus rapide
' que de renvoyer les données par une fonction).
'----------------------------------------------------------------------------------------
' TabDonnées : Le tableau de données à trier.
' Colonne : La colonne où sont les données concernées.
' Méthode : 0 = Renvoie les données classées par ordre croissant.
'           1 = Renvoie les données classées par ordre décroissant.
'           2 = Renvoie l'ordre de classement des données.
'           3 = Renvoie l'ordre de classement des données, même rang pour les égalités.
'           4 = Renvoie l'ordre inversé de classement des données.
'           5 = Renvoie l'ordre inversé de classement des données, même rang pour les égalités.
'               Cette méthode ne peut concerner que des numériques.
' RespecterCasse : True pour respecter la casse, False dans le cas contraire.
' Rank : Alimente un tableau de données suivant la méthode demandée.
'----------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

Dim Ref() As Long
ReDim Ref(LBound(TabDonnées) To UBound(TabDonnées))
Dim DernierEgal() As Long
ReDim DernierEgal(LBound(TabDonnées) To UBound(TabDonnées))
Dim Dico() As Long
ReDim Dico(0 To UBound(TabDonnées))
Dim NbDico As Long, TR As Integer
Dim j As Integer
Dim PremierMaxi As Long, PremierMini As Long

' Détermine la base 0 ou base 1 (ou autre base):
Dim E As Long, i As Long, Mini As Long, Maxi As Long, Anc As Long
Dim Base As Integer
Base = LBound(TabDonnées)

' Si un seul élément dans la liste:
If LBound(TabDonnées) = UBound(TabDonnées) Then
If Méthode = 0 Or Méthode = 1 Then Rank = TabDonnées
If Méthode > 1 Then
ReDim Rank(Base To Base)
Rank(Base) = Base
End If
Exit Sub
End If

' Mémorise les données de la colonne désirée dans un tableau à une dimension
' pour aller plus vite dans les traitements:
ReDim Tps(Base To UBound(TabDonnées)) As Variant

If Méthode = 5 Then

For i = Base To UBound(TabDonnées)
Tps(i) = -TabDonnées(i, Colonne)
Next i
Méthode = 3

Else

Select Case RespecterCasse
Case True ' Reprise des données en tenant compte de la casse.
For i = Base To UBound(TabDonnées)
Tps(i) = TabDonnées(i, Colonne)
Next i
Case False ' Transforme les données en majuscules pour ignorer la casse.
For i = Base To UBound(TabDonnées)
Tps(i) = UCase(TabDonnées(i, Colonne))
Next i

End Select

End If

' Retrouve l'ordre de classement des deux premiers éléments:
If Tps(Base) > Tps(Base + 1) Then
Mini = Base + 1: Maxi = Base
Else
Mini = Base: Maxi = Base + 1
End If

' Initialise les deux premiers éléments:
Ref(Mini) = Maxi
DernierEgal(Mini) = Mini
If Tps(Mini) = Tps(Maxi) Then DernierEgal(Mini) = Maxi
PremierMini = Mini
Ref(Maxi) = -1
DernierEgal(Maxi) = Maxi
PremierMaxi = Maxi

' Initialise le tableau pour la recherche dichotomique:
Dico(0) = Mini
Dico(1) = Maxi
NbDico = 1
Dim Début As Long, Fin As Long
Dim NbRechercheDicho As Integer
NbRechercheDicho = 2

' Boucle sur les éléments:
' ~~~~~~~~~~~~~~~~~~~~~~~~
Dim Valeur As Variant
i = Base + 1
For E = Base + 2 To UBound(TabDonnées)

' Analyse de l'élément TabDonnées(E, Colonne):
Valeur = Tps(E)

' S'il est compris entre le minimum et le maximum:
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
While Valeur > Tps(Mini) And Valeur < Tps(Maxi)

' Recherche dichotomique pour s'approcher de l'élément:
Début = 0: Fin = NbDico
For j = 2 To NbRechercheDicho
i = (Début + Fin) / 2
If Valeur > Tps(Dico(i)) Then Début = i Else Fin = i
Next j
While Valeur < Tps(Dico(i)): i = i - 1: Wend

i = Dico(i)
TR = 0

' Affine la recherche pour trouver la bonne position:
While Tps(i) < Valeur
Anc = i
i = Ref(DernierEgal(i))
TR = TR + 1
Wend

' Si c'est un élément existant:
While Tps(i) = Valeur
Ref(E) = Ref(DernierEgal(i))
Ref(DernierEgal(i)) = E
DernierEgal(i) = E
DernierEgal(E) = E
GoTo Element_Suivant
Wend

' Si c'est un nouvel élément:
Ref(E) = Ref(DernierEgal(Anc))
DernierEgal(E) = E
Ref(DernierEgal(Anc)) = E

' Alors possibilité de mettre à jour le
' tableau pour la recherche dichotomique:
While TR > NbRechercheDicho
Anc = Mini
NbDico = 0
While Anc <> -1
Dico(NbDico) = Anc
Anc = Ref(DernierEgal(Anc))
NbDico = NbDico + 1
Wend
Dico(NbDico) = Maxi
TR = 0
NbRechercheDicho = 1 + Log(NbDico) / Log(2)
Wend

GoTo Element_Suivant

Wend

' Autres cas particuliers:
' ~~~~~~~~~~~~~~~~~~~~~~~~
Select Case Valeur

' Si c'est un nouveau maximum:
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Case Is > Tps(Maxi)
Ref(Maxi) = E
Maxi = E
Ref(E) = -1
DernierEgal(E) = E
NbDico = NbDico + 1
Dico(NbDico) = E
NbRechercheDicho = 1 + Log(NbDico) / Log(2)
PremierMaxi = Maxi

' Si c'est un nouveau minimum:
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Case Is < Tps(Mini)
Ref(E) = Mini
DernierEgal(E) = E
Mini = E
Dico(0) = E
PremierMini = E

' S'il est égal au maximum:
' ~~~~~~~~~~~~~~~~~~~~~~~~~
Case Is = Tps(Maxi)
Ref(Maxi) = E
DernierEgal(Maxi) = E
DernierEgal(PremierMaxi) = E
Ref(E) = -1
DernierEgal(E) = E
Maxi = E
If Tps(Mini) = Tps(Maxi) Then DernierEgal(Mini) = E

' Si c'est égal au minimum:
' ~~~~~~~~~~~~~~~~~~~~~~~~~
Case Else 'Is = Tps(Mini)
Ref(E) = Ref(DernierEgal(Mini))
DernierEgal(E) = E
Ref(DernierEgal(Mini)) = E
DernierEgal(Mini) = E
DernierEgal(PremierMini) = E

End Select

Element_Suivant:
'~~~~~~~~~~~~~~~
Next E

' Alimente Rank suivant la méthode désirée:
Select Case Méthode

' Classement par ordre croissant:
Case Is = 0
i = Mini
E = Base
' Saute la partie qui est déjà triée correctement:
If Mini = Base Then
Rank = TabDonnées
While i = E
E = E + 1
i = Ref(i)
Wend
Else
ReDim Rank(Base To UBound(TabDonnées), Base To UBound(TabDonnées, 2))
End If
' Dans tous les cas:
Dim LB As Byte, UB As Integer
LB = LBound(TabDonnées, 2)
UB = UBound(TabDonnées, 2)
' Boucle pour la lecture des éléments suivants, plus ils sont mélangés
' dans "i = ref(i)" et plus le temps de traitement sera long:
For E = E To UBound(TabDonnées)
For j = LB To UB
Rank(E, j) = TabDonnées(i, j)
Next j
i = Ref(i)
Next E

' Classement par ordre décroissant:
Case Is = 1
Rank = TabDonnées
E = UBound(TabDonnées)
i = Mini
While i <> -1
For j = LBound(TabDonnées, 2) To UBound(TabDonnées, 2)
Rank(E, j) = TabDonnées(i, j)
Next j
i = Ref(i)
E = E - 1
Wend

' Ordre de classement:
Case Is = 2
ReDim Rank(LBound(TabDonnées) To UBound(TabDonnées))
i = Mini
For E = Base To UBound(TabDonnées)
Rank(i) = E
i = Ref(i)
Next E

' Ordre de classement, avec même rang sur les égalités:
Case Is = 3
ReDim Rank(LBound(TabDonnées) To UBound(TabDonnées))
E = Base
i = Mini
Rank(i) = E
Anc = i
i = Ref(i)
For E = Base + 1 To UBound(TabDonnées)
If TabDonnées(i, Colonne) <> TabDonnées(Anc, Colonne) Then
Rank(i) = E
Else
Rank(i) = Rank(Anc)
End If
Anc = i
i = Ref(i)
Next E

' Ordre de classement inversé:
Case Is = 4
ReDim Rank(LBound(TabDonnées) To UBound(TabDonnées))
i = Mini
For E = Base To UBound(TabDonnées)
Rank(i) = UBound(TabDonnées) + 1 - E
i = Ref(i)
Next E

End Select

' Fin du traitement:
Gest_Err:

If Err.Number <> 0 Then
Err.Raise Err.Number, "DataQR", Err.Description
End If
Err.Clear

End Sub

'----------------------------------------------------------------------------------------
Public Function DataReverse(DataTable As Variant) As Variant
'----------------------------------------------------------------------------------------
' Inverse l'ordre du tableau de données passé dans l'argument DataTable.
'----------------------------------------------------------------------------------------
' DataTable : Le tableau de données qui contient les données.
'----------------------------------------------------------------------------------------
' Renvoie : Un tableau en ordre inversé.
'----------------------------------------------------------------------------------------
Dim i As Long, j As Integer, Ik As Long

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

' Renvoie le tableau des données:
Dim Tps
ReDim Tps(LBound(DataTable) To UBound(DataTable), LBound(DataTable, 2) To UBound(DataTable, 2))
Ik = UBound(DataTable)
For i = LBound(DataTable) To UBound(DataTable)
For j = LBound(DataTable, 2) To UBound(DataTable, 2)
Tps(Ik, j) = DataTable(i, j)
Next j
Ik = Ik - 1
Next i

' Renvoie le tableau inversé:
DataReverse = Tps

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

End Function

'----------------------------------------------------------------------------------------
Public Function DataUnique(DataTable As Variant, Optional MatchCase As Boolean = True) As Variant
'----------------------------------------------------------------------------------------
' Analyse le tableau de données passé dans l'argument DataTable pour supprimer les doublons.
' Toutes les colonnes des éléments sont analysées pour déterminer s'il y a un doublon.
'----------------------------------------------------------------------------------------
' DataTable : Le tableau de données en base 1 qui contient les données.
' MatchCase : True pour que la recherche respecte la casse, False dans l'autre cas.
'----------------------------------------------------------------------------------------
' Renvoie : Un tableau de données en base 1 sans doublon classé par ordre croissant.
'----------------------------------------------------------------------------------------
Dim i As Long, j As Integer, NbUnique As Long, Ik As Long
Dim NbDimension As Integer

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

' Définition du nombre de colonnes dans la liste source:
NbDimension = UBound(DataTable, 2)

' Trie la liste sur toutes ses colonnes:
Dim V As Variant
ReDim V(0 To NbDimension - 1)
For j = 0 To NbDimension - 1: V(j) = j + 1: Next j

Dim Tps As Variant
Call DataSort(DataTable, V, MatchCase, Tps)

' Création du tableau temporaire:
NbUnique = 1
ReDim Ref(1 To UBound(Tps))
Ref(1) = 1

' Boucle sur les éléments pour les comparer au précédent:
For i = 2 To UBound(Tps)
For j = 0 To NbDimension - 1
If VbCompare(Tps(i, j + 1), "<>", Tps(i - 1, j + 1), MatchCase) Then Exit For
Next j
If j < NbDimension Then
NbUnique = NbUnique + 1
Ref(NbUnique) = i
End If
Next i

' Renvoie le tableau des données:
Dim List As Variant
ReDim List(1 To NbUnique, 1 To UBound(Tps, 2))
For i = 1 To NbUnique
Ik = Ref(i)
For j = 1 To UBound(Tps, 2)
List(i, j) = Tps(Ik, j)
Next j
Next i

' Renvoie une liste unique:
DataUnique = List

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

End Function

'----------------------------------------------------------------------------------------
Public Function DataUpdateItem(DataTable As Variant, Column As Variant, _
Action As String, Value As Variant, _
Item As Long) As Boolean
'----------------------------------------------------------------------------------------
' Fait la mise à jour d'une colonne dans un tableau de données pour l'élément indiqué.
'----------------------------------------------------------------------------------------
' DataTable : Le tableau de données en base 1 qui contient les données.
' Column : La colonne 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 DataUpdateElement(DataTable, Item, VbValue(Column), Action, Value)

' Renvoie Vrai:
DataUpdateItem = True

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

End Function

'----------------------------------------------------------------------------------------
Private Sub DataUpdateElement(DataTable As Variant, i As Long, Index As Integer, _
Action As String, Value As Variant)
'----------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

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

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

End Sub

'----------------------------------------------------------------------------------------
Public Function DataUpdateAll(DataTable As Variant, ByVal Column As Variant, _
Action As String, Value As Variant, _
ByVal ArrayColumnCompareValue As Variant, _
Optional MatchCase As Boolean = True, _
Optional ByVal Sorted As Boolean = False) As Boolean
'----------------------------------------------------------------------------------------
' Fait la mise à jour d'une colonne dans un tableau de données pour les éléments qui
' correspondent aux critères indiqués dans les arguments.
'----------------------------------------------------------------------------------------
' DataTable : Le tableau de données en base 1 qui contient les données.
' Column : La colonne dont il faut faire la mise à jour.
' Action : "=" Modification.
'          "+" Ajout.
'          "-" Soustraction
'          "*" Multiplication
'          "/" Division
' Value : La nouvelle valeur pour la colonne.
' 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.
' 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 au moins un élément est corrigé, ou False dans le cas contraire.
'----------------------------------------------------------------------------------------
Dim i As Long, j As Integer, Début As Long
Dim V

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

' Correction des noms de colonne:
For j = 0 To UBound(ArrayColumnCompareValue) Step 3
ArrayColumnCompareValue(j) = VbValue(ArrayColumnCompareValue(j))
Next j
Column = VbValue(Column)

' Si la liste est triée et que l'on cherche une valeur:
If Sorted = True And ArrayColumnCompareValue(1) = "=" Then
Début = DataIndexOf(DataTable, ArrayColumnCompareValue, MatchCase, Sorted)
If Début < 1 Then Début = 1: Sorted = False
Else
Sorted = False
End If

' Fait la mise à jour dans un tableau de données provisoire:
Dim List
List = DataTable

' Boucle pour la mise à jour des éléments qui répondent aux critères de sélection:
If Début < 1 Then Début = 1
For i = Début To UBound(DataTable)
If Sorted = True Then
If DataTable(i, ArrayColumnCompareValue(0)) <> DataTable(Début, ArrayColumnCompareValue(0)) Then
Exit For
End If
End If
For j = 0 To UBound(ArrayColumnCompareValue) Step 3
V = DataTable(i, ArrayColumnCompareValue(j))
If VbCompare(V, ArrayColumnCompareValue(j + 1), ArrayColumnCompareValue(j + 2), MatchCase) = False Then Exit For
Next j
If j > UBound(ArrayColumnCompareValue) Then
Call DataUpdateElement(List, i, Int(Column), Action, Value)
DataUpdateAll = True
End If
Next i

' Corrige le tableau de données passé en argument:
DataTable = List

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

End Function

'----------------------------------------------------------------------------------------
Public Function DataAddItem(DataTable As Variant, ByVal ArrayValues As Variant, _
Optional ByVal Index As Long = 0) As Boolean
'----------------------------------------------------------------------------------------
' Ajoute un élément au tableau de données.
'----------------------------------------------------------------------------------------
' DataTable : Le tableau de données en base 1 qui contient les données.
' ArrayValues : Array des valeurs à ajouter (dans l'ordre des colonnes de l'objet).
' Index : La position où insérer l'élément dans le tableau (en base 1), ou 0 pour
'         l'ajouter à la suite du tableau.
'----------------------------------------------------------------------------------------
' Renvoie : True si tout s'est bien passé, False dans le cas contraire.
'----------------------------------------------------------------------------------------
Dim i As Long, j As Integer

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

' Corrections de la position demandée:
If Index > UBound(DataTable) Then Index = 0
If Index < 1 Then Index = UBound(DataTable) + 1

' Traitement sur un tableau de données provisoire:
Dim List
ReDim List(1 To UBound(DataTable) + 1, 1 To UBound(DataTable, 2))

' Copie les données avant la position demandée:
For i = 1 To Index - 1
For j = 1 To UBound(DataTable, 2): List(i, j) = DataTable(i, j): Next j
Next i

' Copie les données après la position demandée:
For i = Index + 1 To UBound(DataTable) + 1
For j = 1 To UBound(DataTable, 2): List(i, j) = DataTable(i - 1, j): Next j
Next i

' Force l'argument en type Array:
If IsArray(ArrayValues) = False Then ArrayValues = Array(ArrayValues)

' Mise à jour des données de la position demandée:
For j = 1 To UBound(ArrayValues) + 1: List(Index, j) = ArrayValues(j - 1): Next j

' Renvoie le tableau de données corrigé:
DataTable = List

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

End Function

'----------------------------------------------------------------------------------------
Public Function DataRemove(DataTable As Variant, _
ByVal ArrayColumnCompareValue As Variant, _
Optional MatchCase As Boolean = True) As Long
'----------------------------------------------------------------------------------------
' Supprime les éléments dans un tableau de données qui correspondent à la méthode de
' comparaison et aux critères de recherche indiqués dans les arguments.
'----------------------------------------------------------------------------------------
' DataTable : Le tableau de données en base 1 qui contient les données.
' 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, Ik As Long
Dim V

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

' Correction des noms de colonne:
For j = 0 To UBound(ArrayColumnCompareValue) Step 3
ArrayColumnCompareValue(j) = VbValue(ArrayColumnCompareValue(j))
Next j

' Itilise un tableau pour identifier les données à supprimer:
Dim Ref
ReDim Ref(1 To UBound(DataTable)) As Byte

For i = 1 To UBound(DataTable)
For j = 0 To UBound(ArrayColumnCompareValue) Step 3
V = DataTable(i, ArrayColumnCompareValue(j))
If VbCompare(V, ArrayColumnCompareValue(j + 1), ArrayColumnCompareValue(j + 2), MatchCase) = False Then Exit For
Next j
If j > UBound(ArrayColumnCompareValue) Then Ref(i) = 1: DataRemove = DataRemove + 1
Next i

' Uilise un tableau provisoire pour y placer les données non supprimées:
If DataRemove > 0 Then

Dim List
ReDim List(1 To UBound(DataTable) - DataRemove, 1 To UBound(DataTable, 2))
Ik = 1

For i = 1 To UBound(DataTable)
If Ref(i) = 0 Then
For j = 1 To UBound(DataTable, 2): List(Ik, j) = DataTable(i, j): Next j
Ik = Ik + 1
End If
Next i

' Renvoie le tableau de données corrigé:
DataTable = List

End If

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

End Function

'----------------------------------------------------------------------------------------
Public Function DataRemoveItem(DataTable As Variant, ByVal Item As Long) As Boolean
'----------------------------------------------------------------------------------------
' Supprime un élément dans un tableau de données d'après sa position.
'----------------------------------------------------------------------------------------
' DataTable : Le tableau de données en base 1 qui contient les données.
' Item : L'indice en base 1 de l'élément à supprimer dans le tableau (ou 0 pour le dernier)
'----------------------------------------------------------------------------------------
' Renvoie : True si True s'est bien passé ou False dans le cas contraire.
'----------------------------------------------------------------------------------------
Dim i As Long, Ik As Long
Dim j As Integer

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

' Correction du numéro de l'élément à supprimer:
If Item < 1 Or Item > DataSize(DataTable) Then Item = DataSize(DataTable)

' Création d'une mémoire temporaire:
ReDim List(1 To UBound(DataTable) - 1, 1 To UBound(DataTable, 2))
Ik = 1

' Boucle pour reprendre tous les éléments sauf celui à supprimer:
For i = 1 To UBound(DataTable)
If i <> Item Then
For j = 1 To UBound(DataTable, 2): List(Ik, j) = DataTable(i, j): Next j
Ik = Ik + 1
End If
Next i

' Récupère la variable temporaire:
DataTable = List

' Renvoie Vrai:
DataRemoveItem = True

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

End Function

'----------------------------------------------------------------------------------------
Public Function DataCount(DataTable As Variant, _
ByVal ArrayColumnCompareValue As Variant, _
Optional MatchCase As Boolean = True, _
Optional Sorted As Boolean = False) As Long
'----------------------------------------------------------------------------------------
' Compte le nombre d'éléments dans un tableau de données qui correspondent à la méthode
' de comparaison et aux critères de recherche indiqués dans les arguments.
'----------------------------------------------------------------------------------------
' DataTable : Le tableau de données en base 1 qui contient les données.
' 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 V

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

' Correction des noms de colonne:
For j = 0 To UBound(ArrayColumnCompareValue) Step 3
ArrayColumnCompareValue(j) = VbValue(ArrayColumnCompareValue(j))
Next j

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

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

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

End Function

'----------------------------------------------------------------------------------------
Public Function DataSum(DataTable As Variant, 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 tableau de données
' qui correspondent à la méthode de comparaison et aux critères de recherche indiqués dans
' les arguments.
'----------------------------------------------------------------------------------------
' DataTable : Le tableau de données en base 1 qui contient les données.
' Column : La colonne 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 V

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

' Correction des noms de colonne:
For j = 0 To UBound(ArrayColumnCompareValue) Step 3
ArrayColumnCompareValue(j) = VbValue(ArrayColumnCompareValue(j))
Next j
Column = VbValue(Column)

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

' Traitement si la liste n'est pas triée:
For i = 1 To UBound(DataTable)
For j = 0 To UBound(ArrayColumnCompareValue) Step 3
V = DataTable(i, ArrayColumnCompareValue(j))
If VbCompare(V, ArrayColumnCompareValue(j + 1), ArrayColumnCompareValue(j + 2), MatchCase) = False Then Exit For
Next j
If j > UBound(ArrayColumnCompareValue) Then DataSum = DataSum + DataTable(i, Column)
Next i

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

End Function

'----------------------------------------------------------------------------------------
Public Function DataBase1ToBase0(DataTable As Variant) As Variant
'----------------------------------------------------------------------------------------
' Créé un tableau de données en base 0 à partir d'un tableau de données en base 1.
'----------------------------------------------------------------------------------------
' DataTable : Le tableau de données en base 1 qui contient les données.
'----------------------------------------------------------------------------------------
' Renvoie : Le tableau de données en base 0 qui contient les données.
'----------------------------------------------------------------------------------------
Dim i As Long, j As Integer
Dim Tps

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

' Si le tableau est déjà en base 0 alors ne rien faire:
If LBound(DataTable, 2) = 0 Then DataBase1ToBase0 = DataTable: GoTo Gest_Err

' Création d'un tableau en base 0
ReDim Tps(0 To UBound(DataTable) - 1, 0 To UBound(DataTable, 2) - 1)
For i = 1 To UBound(DataTable)
For j = 1 To UBound(DataTable, 2)
Tps(i - 1, j - 1) = DataTable(i, j)
Next j
Next i

' Renvoie le tableau:
DataBase1ToBase0 = Tps

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

End Function

'----------------------------------------------------------------------------------------
Public Function DataBase0ToBase1(DataTable As Variant) As Variant
'----------------------------------------------------------------------------------------
' Créé un tableau de données en base 1 à partir d'un tableau de données en base 0.
'----------------------------------------------------------------------------------------
' DataTable : Le tableau de données en base 0 qui contient les données.
'----------------------------------------------------------------------------------------
' Renvoie : Le tableau de données en base 1 qui contient les données.
'----------------------------------------------------------------------------------------
Dim i As Long, j As Integer
Dim Tps

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

' Si le tableau est déjà en base 1 alors ne rien faire:
If LBound(DataTable, 1) = 1 Then DataBase0ToBase1 = DataTable: GoTo Gest_Err

' Création d'un tableau en base 0
ReDim Tps(1 To UBound(DataTable) + 1, 1 To UBound(DataTable, 2) + 1)
For i = 0 To UBound(DataTable)
For j = 0 To UBound(DataTable, 2)
Tps(i + 1, j + 1) = DataTable(i, j)
Next j
Next i

' Renvoie le tableau:
DataBase0ToBase1 = Tps

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

End Function

'----------------------------------------------------------------------------------------
Public Function DataSize(DataTable As Variant) As Long
'----------------------------------------------------------------------------------------
' Renvoie le nombre d'éléments dans un tableau.
'----------------------------------------------------------------------------------------
' DataTable : Le tableau de données en base 1 qui contient les données.
'----------------------------------------------------------------------------------------
' Renvoie : Le nombre d'éléments du tableau ou 0 s'il n'en a pas.
'----------------------------------------------------------------------------------------
If IsArray(DataTable) = False Then GoTo Gest_Err
On Error Resume Next
DataSize = UBound(DataTable) - LBound(DataTable) + 1

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

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

End Function

'----------------------------------------------------------------------------------------
Private 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
Exit Function

' 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(DataTable As Variant, ByVal Column As Long, Value As Variant, _
MatchCase As Boolean) As Long
'----------------------------------------------------------------------------------------
' Fait une recherche dichotomique dans un tableau de données par ordre croissant sur la colonne Column.
'----------------------------------------------------------------------------------------
' DataTable : Le tableau de données en base 1 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.
' MatchCase : True pour que la recherche respecte la casse, False dans l'autre cas.
'----------------------------------------------------------------------------------------
' 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 = UBound(DataTable)
Début = 1
If VbCompare(Value, ">", DataTable(Fin, Column)) Then Exit Function
If VbCompare(Value, "<", DataTable(Début, Column)) Then Exit Function

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

' Recherche dichotomique:
Anc = 1
Do
i = (Début + Fin) / 2
If VbCompare(Value, ">", DataTable(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, "=", DataTable(Anc, Column)) Then RechercheDichotomique = Anc

End Function
'----------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------