I. Prologue▲
Bob est amoureux d'Alice, mais il est maladroit. Jugez-en par vous-même : plutôt que de lui écrire des poèmes, il lui a écrit un mode d'emploi sur le VBA (voir le tome 1 : Des bases de la programmation à l'algorithme de classement rapide QuickRanking) ; au lieu de lui offrir des fleurs, il a fait un programme pour illuminer la tour Eiffel sur son écran d'ordinateur (voir le tome 2 : Des bases de la programmation en mode graphique à la programmation d'un jeu d'arcade en VBA et Microsoft Excel) ; tandis qu'elle rêvait d'un voyage au bout du monde, il a calculé le moyen le plus rapide pour faire le tour de la France (voir le tome 3 : Problème du Voyageur de commerce - Une méthode d'approximation basée sur des principes simples); et pour l'inviter au restaurant, il lui envoie des messages codés (voir le tome 4 : Un algorithme de chiffrement/déchiffrement des cellules pour une meilleure confidentialité) ; enfin, quand Alice lui demandait sa protection, elle ne parlait pas de ses fichiers (voir le 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).
Mais les temps changent et ce soir Bob sort le grand jeu.
« Alors même si le projet est fou, Alice s'est laissé convaincre, a enfilé sa robe moulante au décolleté avantageux, en prenant soin de ne pas filer ses bas avec ses ongles fraichement vernis, et après vingt-et-une secondes de sèche-cheveu elle ordonna sa crinière en chignon pour dégager sa nuque.
Enfin, tout émue mais toute contente, Alice lança çà et là quelques pétales de rose pour décorer avec gout cette scène trop exigüe.
- Gardes-en pour la suite, suggéra Bob, et garde à l'esprit que nos lecteurs ne sentent pas ce doux parfum, et ne savent même pas leur couleur.
- Rouges ou orange : les deux sont permis.' »
N'allez pas voir ici des stéréotypes machistes, c'est juste qu'Alice veut être à la hauteur face au costume à paillettes tendance années 80 de Bob qui met en valeur son joli petit cul. Alors refermons cette dédicace à un amoureux de la langue française (qui n'est pas Français) et revenons à notre sujet.
Ce sixième et dernier volet de cette hexalogie sur la programmation en VBA pour EXCEL explore un aspect qui n'a pas été souvent abordé dans les précédents mémentos : le développement de fonctions pour simplifier la vie des utilisateurs (et non plus des programmeurs).
Un vaste sujet dont on peut difficilement faire le tour en quelques pages.
Alors ici nous ne présenterons que le contour des techniques à utiliser. Rassurez-vous, il n'y a rien de bien compliqué, d'autant plus qu'Alice et Bob vous guideront au fil de votre lecture.
II. Acte I - Scène I▲
Commençons par un problème récurrent dans EXCEL, la gestion des doublons.
- Car si les fonctions intégrées permettent de :
supprimer les doublons d'une liste, via le menu « Données / Supprimer les doublons » (soit en VBA la méthode RemoveDuplicates qui est très bien expliquée dans l'aide) ; - et de générer une liste sans doublon, via le menu « Données / Filtres avancés / Extraction sans doublon » (quand les données sont déjà triées) ;
- aucune ne permet d'identifier les éventuels doublons d'une liste et de les sélectionner pour un traitement ultérieur : mise en surbrillance, suppression, déplacement, copie, et autres possibilités classiques au choix de l'utilisateur.
Il faut alors que l'utilisateur se lance dans de multiples manipulations, certes pas bien compliquées, mais pas vraiment passionnantes non plus.
L'objectif de Bob est de créer cette nouvelle fonction pour simplifier la vie des usagers d'EXCEL.
Il existe bien sûr différentes façons de procéder en VBA pour savoir si une cellule est en doublon, par exemple en utilisant la méthode CountIf(Arg1, Arg2), qui retourne le nombre de fois où Arg2 (qui représente la valeur de la cellule analysée) est présent dans la plage Arg1.
Ce qui donne le programme suivant :
'---------------------------------------------------------------------------------------
Function
SélectionDoublonsCountIf
(
) As
Long
'---------------------------------------------------------------------------------------
Dim
MaPlage As
Range, Cellule As
Range, NbDoublon As
Long
, i As
Long
' Récupère la plage sélectionnée par l'utilisateur:
Set
MaPlage =
Selection.Areas
(
1
)
' Limite la sélection aux cellules actives si toute la colonne est sélectionnée:
If
MaPlage.Areas
(
1
).Count
=
Application.Rows.Count
Then
' En partant de la fin recherche la 1re ligne non vide:
i =
Cells
(
Application.Rows.Count
, MaPlage.Column
).End
(
xlUp).Row
' Modifie la plage sélectionnée:
Set
MaPlage =
Range
(
Cells
(
1
, MaPlage.Column
), Cells
(
i, MaPlage.Column
))
End
If
' Boucle sur les cellules de cette plage:
For
Each
Cellule In
MaPlage
' Si la valeur de la cellule est présente plusieurs fois alors c'est un doublon:
If
Application.WorksheetFunction.CountIf
(
MaPlage, Cellule.Value
) >
1
Then
' Pour le premier cas rencontré, sélectionne la cellule:
If
NbDoublon =
0
Then
Cellule.Select
NbDoublon =
1
Else
' Pour les autres cas rencontrés, ajoute la cellule à la sélection existante.
NbDoublon =
NbDoublon +
1
Union
(
Selection, Cellule).Select
End
If
End
If
Next
SélectionDoublonsCountIf =
NbDoublon ' Retourne le nombre de doublons sélectionnés.
End
Function
'---------------------------------------------------------------------------------------
C'est facile, ça marche, mais essayez donc de faire tourner ce programme sur une liste de 10 000 lignes… ça rame, et il faut patienter 13 secondes : le temps que le programme relance 10 000 fois le même traitement, à savoir analyser 10 000 lignes. Soit 10 000 x 10 000 = 100 000 000 analyses.
Alors imaginez sur les 1 048 576 lignes d'une feuille de calcul : c'est mission impossible.
C'est pourquoi Bob va s'y prendre autrement. Laissons-le nous expliquer comment :
Mon programme va lire les données une fois, et les trier dans une mémoire annexe avec la fonction QuickRanking qui a été décrite dans le tome 1. Pourquoi trier les données ? Parce que, dans une liste triée, une donnée est en doublon si la valeur précédente ou suivante est identique. Ainsi, la seule difficulté est de retrouver le plus rapidement possible la position de la donnée à analyser dans la liste triée. Et justement, la fonction QuickRanking en plus de retourner les données triées, retourne aussi leur ordre de classement.
C'est cet ordre qui permet de savoir immédiatement où se situe la donnée analysée dans la liste triée, et donc de savoir si elle est en doublon ou non en la comparant avec la précédente et la suivante.
Restez concentré pour bien comprendre avec cet exemple.
Soit les données : 7, 8, 1, 3, 6, 1, 2, 8, mémorisées dans TabDonnées().
Avec l'instruction : Classement = QuickRanking(TabDonnées(), True, 2)
Les données sont triées dans la mémoire TabDonnées() et leur rang est retourné dans Classement().
Nous obtenons ce résultat que vous présente Alice :
- Analysons la première donnée, 7 (ligne bleue). Elle est classée 6e en base 1 (ligne blanche), on le sait car Classement(0)=6, soit 5e en base 0 (ligne rouge, 6-1=5) nuance importante car les mémoires sont en base 0 (ligne orange) alors que Classement() est alimenté en base 1. On retrouve ainsi TabDonnées(5) dans la liste triée, qui vaut 7. La valeur précédente (5-1=4), TabDonnées(4) vaut 6, et la suivante (5+1=6) TabDonnées(6) vaut 8. Elle n'est donc pas un doublon.
- Analysons la seconde donnée, 8. Elle est classée 6e en base 0, car Classement(1)-1=7-1=6 . La valeur précédente, TabDonnées(5) vaut 7, et la suivante TabDonnées(7) vaut aussi 8. Elle est donc un doublon.
Avec ce procédé la recherche d'un doublon ne demande plus que deux analyses par ligne. Ce qui fait passer la recherche des doublons sur 10 000 lignes de 13 secondes à 0,17 seconde. C'est presque 100 fois plus rapide.
Cette réduction de la durée du traitement permet de s'attaquer à des listes bien plus grandes.
Sauf que la sélection des cellules avec les méthodes Select et Union, utilisées dans le programme précédent, est très gourmande en ressources, voire fait planter EXCEL lorsqu'on atteint un certain nombre de cellules sélectionnées. Pour contourner ce problème, il faut agir en plusieurs étapes :
- utiliser une couleur de fond pour identifier les cellules en doublon (au lieu de Select et Union) ;
- filtrer les cellules sur cette couleur de fond (c'est très rapide) ;
- sélectionner les cellules visibles (donc les doublons) ;
- effacer le filtre (c'est plus esthétique) ;
- effacer la couleur de fond des cellules sélectionnées (ça supprime les traces du traitement).
Ainsi, ne sont sélectionnées que les cellules en doublon.
L'utilisateur peut maintenant effectuer les traitements de son choix. Par exemple, mettre une couleur de fond, ou copier-coller les données. Mais attention à cette dernière manipulation car en travaillant sur de grandes listes, vous découvrirez à vos dépens que demander à EXCEL de recopier un nombre important de cellules non contiguës provoque un plantage. On va s'en prémunir en profitant du traitement pour recopier les doublons à un autre emplacement à mesure qu'ils sont détectés.
Concrètement, l'utilisateur sélectionne la liste source Selection.Areas(1), puis en maintenant enfoncée la touche [Ctrl], clique sur la cellule de destination Selection.Areas(2) sur la même feuille, mais dans une autre plage. Et lance cette nouvelle fonction, SélectionDoublonsQuickRanking, préalablement ajoutée au menu « Compléments » comme expliqué aux tomes 1 et 5.
Deux remarques : si la source ne contient qu'une cellule alors la liste est étendue automatiquement à la région en cours ; si la liste source sélectionnée contient plusieurs colonnes contiguës alors la comparaison portera sur l'ensemble des données de ses colonnes.
'---------------------------------------------------------------------------------------
Function
SélectionDoublonsQuickRanking
(
) As
Long
'---------------------------------------------------------------------------------------
' Retourne le nombre de doublons et les sélectionne (ou -1 en cas d'erreur).
'---------------------------------------------------------------------------------------
Dim
MaPlage As
Range, Destination As
Range, NbDoublon As
Long
, i As
Long
Dim
Col As
Integer
, CelluleVide As
String
, y As
Long
, Message As
String
Dim
Classement
(
) As
Long
, Item As
Long
, EstDoublon As
Boolean
Dim
AncCalculation As
XlCalculation, AncEnableEvents As
Boolean
' Mémorise le mode de calcul et la gestion des événements:
AncCalculation =
Application.Calculation
AncEnableEvents =
Application.EnableEvents
' Gestion des erreurs (trop de sélections, maxi = 10 colonnes pleines):
On
Error
GoTo
Gest_Err
' Récupère la plage sélectionnée, et l'étend à la région si une seule cellule est sélectionnée:
Set
MaPlage =
Selection.Areas
(
1
)
If
MaPlage.Count
=
1
Then
Set
MaPlage =
MaPlage
(
1
, 1
).CurrentRegion
If
MaPlage.Count
>
Application.Rows.Count
*
10
Then
Err
.Raise
6
' Et la Cellule de la destination si elle est sélectionnée (et dans une colonne différente):
If
Selection.Areas.Count
=
2
Then
Set
Destination =
Selection.Areas
(
2
)
If
Application.Intersect
(
MaPlage, Destination) Is
Nothing
=
False
Then
_
Set
Destination =
Nothing
End
If
' Limite la sélection aux cellules actives si toute la colonne est sélectionnée:
If
MaPlage.Rows.Count
=
Application.Rows.Count
Then
For
Col =
0
To
MaPlage.Columns.Count
-
1
' En partant de la fin recherche la 1re ligne non vide de la colonne:
y =
Cells
(
Application.Rows.Count
, MaPlage.Column
+
Col).End
(
xlUp).Row
If
y >
i Then
i =
y ' Mémorise la dernière ligne la plus grande.
Next
Col
' Modifie la plage sélectionnée:
If
i >
1
Then
Set
MaPlage =
_
Range
(
Cells
(
1
, MaPlage.Column
), Cells
(
i, MaPlage.Column
+
MaPlage.Columns.Count
-
1
))
End
If
' Sélectionne la plage définitive:
MaPlage.Select
' Curseur en attente, mise à jour écran, calculs et événements bloqués:
Application.Cursor
=
xlWait
Application.ScreenUpdating
=
False
Application.Calculation
=
xlCalculationManual
Application.EnableEvents
=
False
' Mémorise les données:
ReDim
TabDonnées
(
0
To
UBound
(
MaPlage
(
)) -
1
) As
Variant
For
Col =
1
To
MaPlage.Columns.Count
For
i =
LBound
(
MaPlage
(
)) To
UBound
(
MaPlage
(
))
TabDonnées
(
i -
1
) =
TabDonnées
(
i -
1
) &
"["
&
MaPlage.Cells
(
i, Col).Value
&
"]"
Next
i
CelluleVide =
CelluleVide &
"[]"
' Contenu d'un ensemble de cellules vides.
Next
Col
' Trie les données et retourne leur ordre de classement (en base 1):
Classement =
QuickRanking
(
TabDonnées
(
), True
, 2
)
' Boucle sur les données classées car en lisant la donnée suivante et précédente
' dans le classement il est possible de savoir si la donnée est en doublon ou non:
For
i =
0
To
UBound
(
MaPlage
(
)) -
1
' Retrouve le rang en base 0 de la cellule à analyser dans la liste classée:
Item =
Classement
(
i) -
1
' Le traitement des doublons ne concerne que les cellules non vides:
If
TabDonnées
(
Item) <>
CelluleVide Then
' La valeur suivante est-elle identique:
If
Item <
UBound
(
Classement
(
)) Then
If
TabDonnées
(
Item +
1
) =
TabDonnées
(
Item) Then
EstDoublon =
True
End
If
' La valeur précédente est-elle identique:
If
Item >
0
Then
If
TabDonnées
(
Item -
1
) =
TabDonnées
(
Item) Then
EstDoublon =
True
End
If
' Si c'est un doublon, alors met une couleur de fond:
If
EstDoublon =
True
Then
Cells
(
MaPlage.Row
+
i, MaPlage.Column
).Interior.Color
=
17
' S'il faut recopier la valeur à un autre emplacement:
If
Destination Is
Nothing
=
False
Then
For
Col =
0
To
MaPlage.Columns.Count
-
1
Cells
(
Destination.Row
+
NbDoublon, Destination.Column
+
Col) =
_
MaPlage
(
1
+
i, 1
+
Col).Value
Next
Col
End
If
EstDoublon =
False
NbDoublon =
NbDoublon +
1
End
If
End
If
Next
i
' S'il y a des doublons:
If
NbDoublon >
0
Then
' Filtre les cellules de la couleur de traitement:
ActiveSheet.Range
(
MaPlage.Address
).AutoFilter
Field:=
1
, _
Criteria1:=
17
, Operator:=
xlFilterCellColor
' S'il faut masquer la 1re ligne:
If
MaPlage
(
1
, 1
).Interior.Color
<>
17
Then
Rows
(
MaPlage.Row
).Hidden
=
True
' Sélectionne les cellules qui sont visibles:
Selection.SpecialCells
(
xlCellTypeVisible).Select
' Affiche la 1re ligne:
Rows
(
MaPlage.Row
).Hidden
=
False
' Efface le filtre
ActiveSheet.Range
(
MaPlage.Address
).AutoFilter
Field:=
1
Selection.AutoFilter
' Efface la couleur de fond des cellules en doublon:
Selection.Interior.Color
=
xlNone ' Efface la couleur de fond
Selection.Interior.Pattern
=
xlNone ' et le motif.
' Revient en haut de la liste:
ActiveWindow.ScrollRow
=
MaPlage.Row
' Prépare la copie des doublons sélectionnés:
Selection.Copy
' Message d'information:
Message =
NbDoublon &
" doublons sélectionnés."
Else
' Message d'information:
Message =
"Votre sélection ne comporte pas de doublon."
End
If
' Fin du traitement:
Gest_Err
:
If
Err
.Number
<>
0
Then
Message =
Err
.Number
&
": "
&
Err
.Description
: NbDoublon =
-
1
Err
.Clear
Application.ScreenUpdating
=
True
Application.Cursor
=
xlDefault
Application.Calculation
=
AncCalculation
Application.EnableEvents
=
AncEnableEvents
' Retourne le nombre de doublons sélectionnés ou -1 si erreur:
SélectionDoublonsQuickRanking =
NbDoublon
' Affiche le message d'information:
MsgBox
Message
End
Function
'---------------------------------------------------------------------------------------
La sélection des doublons sur une liste de 100 000 lignes prend 1,2 seconde, et pour une liste qui couvre les 1 048 576 lignes d'une feuille de calcul, comptez 20 petites secondes, un peu plus s'il faut recopier les doublons à un autre emplacement.
En résumé, la fonction SélectionDoublonsQuickRanking permet :
- de sélectionner les doublons ;
- de recopier les doublons à un autre emplacement.
Vous remarquerez aussi que la fonction EXCEL évoquée plus haut pour générer, inversement, une liste sans doublon via les filtres avancés n'est plus exploitable sur les grandes listes : au mieux elle est très longue ; au pire elle fait planter le système. Il faut alors faire un copier-coller en valeur de la liste d'origine et utiliser la fonction de suppression des doublons.
Une variante du programme qui vient d'être présenté peut y remédier : en effet, générer une liste sans doublon consiste à ignorer les valeurs qui ont une valeur précédente identique dans la liste triée, et recopier les autres sur la destination choisie.
Comme précédemment, l'utilisateur sélectionne la liste source, puis en maintenant enfoncée la touche [Ctrl], clique sur la cellule de destination (sur la même feuille et dans une plage différente). Et lance la nouvelle fonction ListeSansDoublonQuickRanking.
'---------------------------------------------------------------------------------------
Function
ListeSansDoublonQuickRanking
(
) As
Long
'---------------------------------------------------------------------------------------
Dim
MaPlage As
Range, Destination As
Range, NbDoublon As
Long
, i As
Long
, EstDoublon As
Boolean
Dim
Col As
Integer
, CelluleVide As
String
, y As
Long
, Message As
String
Dim
Classement
(
) As
Long
, Item As
Long
Dim
AncCalculation As
XlCalculation, AncEnableEvents As
Boolean
' Mémorise le mode de calcul et la gestion des événements:
AncCalculation =
Application.Calculation
AncEnableEvents =
Application.EnableEvents
' Gestion des erreurs (trop de sélections, maxi = 10 colonnes pleines):
On
Error
GoTo
Gest_Err
' Récupère la plage sélectionnée, et l'étend à la région si une seule cellule est sélectionnée:
Set
MaPlage =
Selection.Areas
(
1
)
If
MaPlage.Count
=
1
Then
Set
MaPlage =
MaPlage
(
1
, 1
).CurrentRegion
If
MaPlage.Count
>
Application.Rows.Count
*
10
Then
Err
.Raise
6
' Et la Cellule de la destination si elle est sélectionnée (et dans une colonne différente):
If
Selection.Areas.Count
=
2
Then
Set
Destination =
Selection.Areas
(
2
)
If
Application.Intersect
(
MaPlage, Destination) Is
Nothing
=
False
Then
_
Set
Destination =
Nothing
End
If
If
Destination Is
Nothing
=
True
Then
Message =
"Vous devez sélectionner une liste source puis une destination "
_
&
"sur une autre colonne de la feuille en maintenant la touche [Ctrl] enfoncée."
NbDoublon =
-
1
Err
.Raise
6
End
If
' Limite la sélection aux cellules actives si toute la colonne est sélectionnée:
If
MaPlage.Rows.Count
=
Application.Rows.Count
Then
For
Col =
0
To
MaPlage.Columns.Count
-
1
' En partant de la fin recherche la 1re ligne non vide de la colonne:
y =
Cells
(
Application.Rows.Count
, MaPlage.Column
+
Col).End
(
xlUp).Row
If
y >
i Then
i =
y ' Mémorise la dernière ligne la plus grande.
Next
Col
' Modifie la plage sélectionnée:
If
i >
1
Then
Set
MaPlage =
_
Range
(
Cells
(
1
, MaPlage.Column
), Cells
(
i, MaPlage.Column
+
MaPlage.Columns.Count
-
1
))
End
If
' Sélectionne la plage définitive:
MaPlage.Select
' Curseur en attente, mise à jour écran, calculs et événements bloqués:
Application.Cursor
=
xlWait
Application.ScreenUpdating
=
False
Application.Calculation
=
xlCalculationManual
Application.EnableEvents
=
False
' Mémorise les données:
ReDim
TabDonnées
(
0
To
UBound
(
MaPlage
(
)) -
1
) As
Variant
For
Col =
1
To
MaPlage.Columns.Count
For
i =
LBound
(
MaPlage
(
)) To
UBound
(
MaPlage
(
))
TabDonnées
(
i -
1
) =
TabDonnées
(
i -
1
) &
"["
&
MaPlage.Cells
(
i, Col).Value
&
"]"
Next
i
CelluleVide =
CelluleVide &
"[]"
' Contenu d'un ensemble de cellules vides.
Next
Col
' Trie les données et retourne leur ordre de classement (en base 1):
Classement =
QuickRanking
(
TabDonnées
(
), True
, 2
)
' Boucle sur les données classées car en lisant la donnée précédente dans le
' classement il est possible de savoir si la donnée est un doublon ou non:
For
i =
0
To
UBound
(
MaPlage
(
)) -
1
' Retrouve le rang en base 0 de la cellule à analyser dans la liste classée:
Item =
Classement
(
i) -
1
EstDoublon =
False
' Le traitement des doublons ne concerne que les cellules non vides:
If
TabDonnées
(
Item) <>
CelluleVide Then
' La valeur précédente est-elle identique:
If
Item >
0
Then
If
TabDonnées
(
Item -
1
) =
TabDonnées
(
Item) Then
NbDoublon =
NbDoublon +
1
EstDoublon =
True
End
If
End
If
' Si ce n'est pas un doublon alors alimente la destination de la valeur de la source:
If
EstDoublon =
False
Then
For
Col =
0
To
MaPlage.Columns.Count
-
1
Cells
(
Destination.Row
+
i -
NbDoublon, Destination.Column
+
Col) =
_
MaPlage
(
1
+
i, 1
+
Col).Value
Next
Col
End
If
End
If
Next
i
Destination.Select
' Fin du traitement:
Gest_Err
:
If
Err
.Number
<>
0
And
Message =
""
Then
_
Message =
Err
.Number
&
": "
&
Err
.Description
: NbDoublon =
-
1
Err
.Clear
Application.ScreenUpdating
=
True
Application.Cursor
=
xlDefault
Application.Calculation
=
AncCalculation
Application.EnableEvents
=
AncEnableEvents
' Retourne le nombre de doublons ou -1 si erreur:
ListeSansDoublonQuickRanking =
NbDoublon
' Affiche le message d'information:
If
Message <>
""
Then
MsgBox
Message
End
Function
'---------------------------------------------------------------------------------------
Résumons tout cela :
Examinons un exemple d'utilisation de ces deux fonctions avec Alice.
Je viens de recevoir une liste d'un million de numéros de téléphone pour une opération commerciale. Cette base contient deux colonnes. En "A" la date d'ouverture de la ligne téléphonique, en "B" le numéro.
Je veux savoir si mon fournisseur est sérieux et ne m'a pas transmis plusieurs fois le même numéro ouvert à la même date.
En "D1" j'écris un libellé : « Les doublons Date + Téléphone ». Je sélectionne les colonnes "A:B", puis la cellule "D2", et je lance la fonction SélectionDoublonsQuickRanking depuis le menu « Sélectionner les doublons » :
En 20 secondes le résultat tombe : il y a 60 doublons qui ont été sélectionnés en colonnes "A" et "B", et recopiés en colonnes "D" et "E".
Un clic sur « Police / Orange » met ces données en surbrillance dans la liste source pour être identifiées facilement par des analyses ultérieures, comme un filtre sur les couleurs par exemple.
Pour obtenir la liste sans doublon des téléphones, je sélectionne la colonne "B", puis la cellule "F1", et je lance la fonction ListeSansDoublonQuickRanking depuis le menu « Liste sans doublon » :
En à peine 30 secondes, j'obtiens ma liste, et je renomme la cellule "F1" en « Téléphone sans doublon ».
Je peux alors comparer cette liste avec la liste des numéros que je possède déjà, placés en colonne "G", avec la fonction RECHERCHEV en colonne "H" :
Sauf que comparer 10 000 numéros demande déjà 9 minutes, et comme j'ai 1 million de numéros en stock, à ce rythme-là le temps de traitement estimé est donc de 15 heures. Il va falloir que Bob vienne à mon secours…
III. Acte I - Scène II▲
Avec la fonction RECHERCHEV nous retombons dans les mêmes travers qu'avec la méthode CountIf. Aux mêmes maux les mêmes remèdes ? Oui. La solution que propose Bob est de sauvegarder les données de la plage source dans une mémoire triée. Savoir si une valeur appartient à cette liste est très rapide avec une recherche dichotomique. Souvenez-vous de la formule du tome 1, « Log(n) / Log(2) », où n est le nombre d'éléments du tableau.
Pour une plus grande souplesse d'utilisation, la fonction ne sera pas lancée depuis un menu, mais sera utilisée comme une fonction de calcul classique d'EXCEL telle que RECHERCHEV.
Elle sera appelée RechercheW et prendra les arguments suivants :
- la valeur recherchée ;
- la plage des données source, qui peut s'étendre sur plusieurs colonnes ;
- le numéro de la colonne, dans cette plage, où porte la recherche. Argument facultatif, par défaut c'est la première colonne de la plage qui est retenue ;
- le numéro de la colonne, dans cette plage, qui contient la donnée à retourner. Argument facultatif, par défaut c'est la première colonne de la plage qui est retenue. Nous y reviendrons plus en détail ;
- le texte à afficher dans la cellule si la recherche est infructueuse ("#N/A" par défaut).
Lors du premier appel à cette fonction, les données de la plage source sont mémorisées et triées. Est aussi mémorisé le numéro de la ligne du classement. Ces mémoires sont déclarées Static dans le module afin d'être conservées. Ainsi lors des appels suivants, la recherche dichotomique peut être faite directement, sans avoir besoin de relancer le tri.
Prenons un exemple.
Soit les données : 10, 8, 1, 3, 6, 1, 2, 8, mémorisées dans TabDonnées().
Avec l'instruction : Classement = QuickRanking(TabDonnées(), True, 2)
Les données sont triées dans la mémoire TabDonnées() et leur rang est retourné dans Classement().
Une boucle sur les données classées est réalisée pour alimenter LigneClassement() qui mémorise le numéro de la ligne pour le rang. Ce que nous explique Alice :
Si l'on fait une boucle sur la mémoire Classement() donc de l'item 0 à 7, respectivement les lignes 1 à 8 :
- la première ligne qui vaut 10 est classée 8e (ligne blanche), soit LigneClassement(8) = 1 ;
- la deuxième ligne qui vaut 8 est classée 6e. LigneClassement(6) = 2 ;
- etc.
À quoi ça sert ? Si l'on cherche une valeur, par exemple 8, la recherche dichotomique sur TabDonnées() retourne qu'elle est trouvée dans la liste en 6e position, or nous savons que LigneClassement(6) vaut 2, c'est-à-dire la deuxième ligne de la plage des données source. Ce qui permet de retourner la valeur de la colonne désirée de la deuxième ligne de cette plage.
Rechercher 10 000 numéros de téléphone parmi une liste d'un million d'autres ne prend plus que 10 secondes au lieu de 9 minutes. Et moins de 2 minutes pour en rechercher un million et non 15 heures.
Remarquez que RechercheW peut aussi remplacer les formules INDEX EQUIV. Voir à ce sujet l'excellent tutoriel de Pierre Fauconnier : « CINQ bonnes raisons de préférer INDEX EQUIV à RECHERCHEV ».
Dans le tableau ci-dessous, la cellule "H2" contient la formule : =RechercheW(G2;A:B;2;1) et retourne la première date d'ouverture de la ligne (colonne 1 de la plage) si le numéro de téléphone (colonne 2 de la plage) est déjà connu dans la liste en stock :
Comme expliqué plus haut, pour trouver la valeur retournée, il a été calculé son rang dans le classement et sa ligne dans la plage. Ces informations peuvent être utiles pour l'utilisateur, d'où l'idée de pouvoir les retourner aussi :
- si le numéro de la colonne à retourner indiqué dans l'argument d'appel est 0, alors c'est la ligne de la plage (et pas la ligne de la feuille, bien qu'elles soient identiques si la plage commence en ligne 1) qui est renvoyée, soit l'équivalent de la formule de calcul EQUIV ;
- si ce numéro est -1, alors c'est le rang de la valeur cherchée qui est renvoyé (les valeurs égales ont le même rang), soit l'équivalent de la formule de calcul EQUATION.RANG, sauf que RechercheW marche aussi pour les valeurs alphabétiques ;
- si ce numéro est -8 ou -9, alors c'est le rang de la ligne qui est renvoyé, en ordre croissant (-8) ou décroissant (-9). Les valeurs égales ont un rang différent qui tient compte de l'ordre d'origine dans la liste. C'est la propriété Application.Caller.Address qui permet de connaître l'adresse de la cellule appelante qui contient RechercheW. Nous verrons un exemple concret par la suite.
La formule de "I2" est : =RechercheW(G2;A:B;2;0). Le numéro recherché a été trouvé à la ligne 5.
La formule de "J2" est : =RechercheW(G2;A:B;2;-1). Le numéro recherché est classé 92 072e par ordre alphabétique.
Trois précisions avant de découvrir le code VBA de ce programme :
- la mise à jour des calculs ne doit se faire que lorsque la source change et pas à chaque fois qu'une cellule de la feuille est modifiée, d'où l'usage de l'instruction Application.Volatile False ;
- s'il n'est pas possible de savoir quand il faut initialiser les mémorisations pour la première fois, une solution de contournement permet de ne pas les relancer inutilement lors d'un copier-coller de la formule… il suffit de mémoriser l'heure du traitement, et si l'appel se fait moins d'une demi-seconde après, c'est qu'il s'agit d'un copier-coller ;
- la plage source peut se trouver sur une autre feuille, voire dans un autre classeur, mais ce dernier doit être ouvert pour la mise à jour des liaisons, contrairement à RECHERCHEV qui peut traiter un classeur fermé.
'---------------------------------------------------------------------------------------
Function
RechercheW
(
ValCherchée As
Variant
, PlageDonnées As
Range, _
Optional
ColRecherche As
Integer
=
1
, _
Optional
ColRetour As
Integer
=
1
, _
Optional
TexteSiNonTrouvé As
String
=
"#N/A"
) As
Variant
'---------------------------------------------------------------------------------------
' Recherche dans la colonne ColRecherche de la plage PlageDonnées la valeur ValCherchée
' et retourne la valeur contenue dans la colonne ColRetour, ou la ligne, ou le rang.
'---------------------------------------------------------------------------------------
' ValCherchée: valeur cherchée.
' PlageDonnées: une plage d'un classeur ouvert.
' si la plage est une ou des colonnes entières alors ajuste la taille.
' si la plage est une seule cellule alors étend la sélection.
' ColRecherche: numéro de la colonne dans la plage (de 1 à n) où porte la recherche.
' ColRetour: numéro de la colonne dans la plage (de 1 à n) où est la valeur à retourner.
' si 0 retourne la ligne dans la plage et pas dans la feuille.
' si -1 retourne le rang de la valeur cherchée (même rang pour les valeurs égales).
' si -8 retourne le rang de la ligne (en tenant compte de l'ordre d'origine).
' si -9 idem -8, mais en ordre décroissant.
' TexteSiNonTrouvé: texte affiché si la valeur n'est pas trouvée ("#N/A" par défaut).
'---------------------------------------------------------------------------------------
Static
Initialise As
Double
Static
TabDonnées
(
) As
Variant
Static
LigneClassement
(
) As
Long
Static
Classement
(
) As
Long
Static
PlageDonnéesAdresse As
String
Dim
i As
Long
, Début As
Long
, Fin As
Long
, Anc As
Long
' Mise à jour des calculs uniquement si la source change:
Application.Volatile
False
' S'il faut initialiser la mémorisation des données:
If
Initialise +
0
.5
<
Timer Or
_
PlageDonnéesAdresse <>
PlageDonnées.Worksheet.Parent.Name
&
PlageDonnées.Parent.Name
_
&
PlageDonnées.Address
&
ColRecherche _
Then
' Déclaration des variables qui seront utilisées:
Dim
y As
Long
, Col As
Long
Dim
Wb As
Workbook, FeuilleSource As
Worksheet
' Identification du classeur contenant les données si différent du classeur actif:
If
PlageDonnées.Worksheet.Parent.Name
<>
ActiveWorkbook.Name
Then
Set
Wb =
Workbooks
(
PlageDonnées.Worksheet.Parent.Name
)
Else
Set
Wb =
ActiveWorkbook
End
If
' Mémorise l'adresse de la plage de données source:
PlageDonnéesAdresse =
PlageDonnées.Worksheet.Parent.Name
&
PlageDonnées.Parent.Name
_
&
PlageDonnées.Address
&
ColRecherche
' Identification dans le classeur concerné de la feuille contenant les données:
Set
FeuilleSource =
Wb.Sheets
(
PlageDonnées.Parent.Name
)
' Limite la sélection aux cellules actives si toute la colonne est sélectionnée:
If
PlageDonnées.Rows.Count
=
Application.Rows.Count
Then
For
Col =
0
To
PlageDonnées.Columns.Count
-
1
' En partant de la fin recherche la 1re ligne non vide de la colonne:
y =
FeuilleSource.Cells
(
Application.Rows.Count
, _
PlageDonnées.Column
+
Col).End
(
xlUp).Row
If
y >
i Then
i =
y ' Mémorise la dernière ligne la plus grande.
Next
Col
' Modifie la plage sélectionnée:
If
i >
1
Then
Set
PlageDonnées =
Range
(
FeuilleSource.Cells
(
1
, PlageDonnées.Column
),_
FeuilleSource.Cells
(
i, PlageDonnées.Column
+
PlageDonnées.Columns.Count
-
1
))
End
If
' Si une seule cellule de sélectionnée, alors étendre automatiquement:
If
PlageDonnées.Count
=
1
Then
Set
PlageDonnées =
Range
(
FeuilleSource.Cells
(
PlageDonnées.Row
, PlageDonnées.Column
),_
FeuilleSource.Cells
(
PlageDonnées.End
(
xlDown).Row
, PlageDonnées.End
(
xlToRight).Column
))
End
If
' Redimensionne les tableaux pour la mémorisation des données:
ReDim
TabDonnées
(
0
To
UBound
(
PlageDonnées
(
)) -
1
) As
Variant
ReDim
LigneClassement
(
1
To
UBound
(
PlageDonnées
(
))) As
Long
' Mémorise les données:
Application.Cursor
=
xlWait
For
i =
1
To
UBound
(
PlageDonnées
(
))
TabDonnées
(
i -
1
) =
PlageDonnées
(
i, ColRecherche).Value
Next
i
' Trie les données et retourne leur ordre de classement:
Classement =
QuickRanking
(
TabDonnées
(
), True
, 2
)
' Adresse les lignes suivant le classement:
For
i =
LBound
(
Classement
(
)) To
UBound
(
Classement
(
))
LigneClassement
(
Classement
(
i)) =
i +
1
Next
i
Application.Cursor
=
xlDefault
End
If
' S'il faut juste retourner le classement de la ligne en ordre croissant:
If
ColRetour =
-
8
Then
RechercheW =
Classement
(
Range
(
Application.Caller.Address
).Row
-
PlageDonnées.Row
)
GoTo
Mémorise_Heure
End
If
' S'il faut juste retourner le classement de la ligne en ordre décroissant:
If
ColRetour =
-
9
Then
RechercheW =
UBound
(
TabDonnées) +
2
_
-
Classement
(
Range
(
Application.Caller.Address
).Row
-
PlageDonnées.Row
)
GoTo
Mémorise_Heure
End
If
' Recherche la donnée dans le tableau trié et retrouve la ligne d'origine.
' En cas d'égalité c'est la première valeur dans la liste qui est retournée:
Début =
LBound
(
TabDonnées): Fin =
UBound
(
TabDonnées): Anc =
Début
' Si la valeur est incluse dans la liste triée alors fait la recherche dichotomique:
If
ValCherchée <
TabDonnées
(
Début) Or
ValCherchée >
TabDonnées
(
Fin) Then
RechercheW =
TexteSiNonTrouvé
Else
Do
i =
(
Début +
Fin) /
2
If
ValCherchée >
TabDonnées
(
i) Then
Début =
i +
1
: Anc =
Début Else
Fin =
i -
1
Loop
While
Début <=
Fin
' Si la valeur est trouvée alors retourne l'information désirée:
If
ValCherchée =
TabDonnées
(
Anc) Then
i =
LigneClassement
(
Anc +
1
)
Select
Case
ColRetour
Case
Is
>
0
: RechercheW =
PlageDonnées
(
i, ColRetour) ' La valeur de la colonne.
Case
0
: RechercheW =
i ' La ligne de la plage, pas de la feuille.
Case
-
1
: RechercheW =
Anc +
1
' Le rang (même rang pour les valeurs égales).
Case
Else
: RechercheW =
"#ERREUR SYNTAXE"
' Autres cas non gérés.
End
Select
Else
RechercheW =
TexteSiNonTrouvé
End
If
End
If
Mémorise_Heure
:
Initialise =
Timer
End
Function
'-------------------------------------------------------------------------------
Vous avez peut-être remarqué en lisant ce code que l'initialisation des mémoires est relancée automatiquement lorsque la plage des données sources ou lorsque la colonne où porte la recherche changent. En conséquence, si vous avez des copier-coller à faire de cellules contenant une formule RechercheW, évitez de recopier en même temps des cellules qui ont ces arguments différents, afin de limiter les initialisations redondantes.
Pour actualiser une feuille qui contient une formule RechercheW sur un fichier fermé, plusieurs possibilités vous sont offertes :
- ouvrir le fichier en question (et refermer le fichier après la mise à jour des calculs) ;
- utiliser le menu « Données / Modifier le lien / Ouvrir la source » (et refermer le fichier) ;
- lancer la fonction ActualiserRechercheW comme événement « sur activation » de la feuille.
'---------------------------------------------------------------------------------------
Public
Sub
ActualiserRechercheW
(
)
'---------------------------------------------------------------------------------------
Dim
C As
Range, Fichier As
String
Dim
Début As
Integer
, Fin As
Integer
, i As
Integer
Dim
WbSource As
Workbook ' Objet Workbook pour le classeur source.
Dim
WbDest As
Workbook ' Objet Workbook pour le classeur destination.
Dim
Sh As
Worksheet ' Objet Worksheet pour la feuille active.
Set
WbSource =
ActiveWorkbook ' Mémorise le classeur actif.
Set
Sh =
ActiveSheet ' Mémorise la feuille active.
' Boucle sur les cellules avec formules de la feuille active:
On
Error
Resume
Next
Application.Cursor
=
xlWait
For
Each
C In
Cells.SpecialCells
(
xlCellTypeFormulas) ' plus rapide que ActiveSheet.UsedRange
' Si la cellule contient une fonction en erreur:
If
C.Text
=
"#VALEUR!"
Then
' Si la cellule contient la fonction RechercheW avec une adresse de fichier:
If
Left
(
C.Formula
, 12
) =
"=RechercheW("
Then
Début =
InStr
(
1
, C.Formula
, "'"
) +
1
Fin =
InStr
(
Début +
1
, C.Formula
, "'"
)
Fichier =
Mid
(
C.Formula
, Début, Fin -
Début)
i =
InStr
(
1
, Fichier, "]"
)
If
i >
0
Then
Fichier =
Left
(
Fichier, i -
1
): Fichier =
Replace
(
Fichier, "["
, ""
)
Set
WbDest =
Workbooks.Open
(
Fichier, , True
) ' Ouvre le fichier en lecture seule.
Sh.Calculate
' Recalcule la feuille active.
WbDest.Close
SaveChanges:=
False
' Ferme le fichier.
WbSource.Activate
' Active le fichier d'origine.
End
If
End
If
Next
C
Application.Cursor
=
xlDefault
End
Sub
'-------------------------------------------------------------------------------
Alice utilise un tableau pour suivre les scores de ses tournois de fléchettes, avec une petite astuce sur les points gagnés car elle ne veut pas d'ex aequo au classement général : elle attribue un bonus aux premiers qui commencent la partie. C'est la dure loi du sport qui prive Bob d'une médaille de bronze bien qu'il ait autant de points qu'Alice.
Voici les formules qu'elle utilisait jusqu'à présent :
- "G3" =SOMME(D3:F3)-($B3/100000) la somme des trois lancés, avec un bonus pour les premiers joueurs ;
- "H3" =SI(G3>0; EQUATION.RANG(G3;G$3:G$7;0); "") si le joueur a lancé au moins une fléchette, alors calcule le classement du joueur pour le tour ;
- "U3" =SI(T3>0; EQUATION.RANG(T3;T$3:T$7;0);"") si le joueur a lancé au moins une fléchette, alors calcule le classement du joueur au général ;
- "X3" =SI(ESTNA(INDEX(C$3:C$7;EQUIV(1;U$3:U$7;0)));"";INDEX(C$3:C$7;EQUIV(1;U$3:U$7;0))) si aucun joueur n'est premier au général, alors la formule EQUIV renvoie « #N/A » et il faut afficher un vide à la place, sinon il faut afficher le résultat de la formule EQUIV, c'est-à-dire le nom du joueur contenu en colonne "C" ;
- "Y3" =SI(ESTNA(INDEX(T$3:T$7;EQUIV(1;U$3:U$7;0)));"";INDEX(T$3:T$7;EQUIV(1;U$3:U$7;0))) idem, mais en affichant les points du joueur en colonne "T".
En utilisant la fonction RechercheW Alice peut remplacer les formules :
- "H3" =SI(G3>0; RechercheW("";G$3:G$7;1;-9); "") le classement du tour en ordre décroissant ;
- "U3" =SI(T3>0; RechercheW("";T$3:T$7;1;-9);"") le classement du général en ordre décroissant ;
- "X3" =RechercheW(1;C$3:U$7;19;1;"") si le premier n'est pas trouvé alors affiche un vide ;
- "Y3" =RechercheW(1;C$3:U$7;19;18;"") si le premier n'est pas trouvé alors affiche un vide.
Bon c'est vrai, il n'y a pas de quoi casser trois pattes à un canard, c'est juste un exemple d'utilisation de la fonction RechercheW. C'est la suite qui va être plus intéressante…
Si Alice ne veut pas d'ex aequo dans le classement des joueurs, c'est juste parce qu'elle ne sait pas gérer cette situation dans le tableau d'attribution des médailles (colonnes "W" à "Y" dans le tableau précédent) où sont affichés les trophées par ordre d'importance, de l'or au bronze.
Ça donnerait ce résultat (colonne "W") qui n'est pas très esthétique :
Il faudrait trier le tableau par points à chaque modification du classement général et donc changer l'ordre d'affichage des joueurs pendant la partie, ou tout simplement écrire un bout de code en VBA, ce qu'Alice ne veut pas. Elle veut une fonction aussi simple à utiliser que RechercheW.
IV. Acte I - Scène III▲
La demande d'Alice est simple à énoncer. Elle désire une formule de calcul qui fait la mise à jour instantanée d'un tri, ici les trois colonnes "X", "Y" et "Z", lorsqu'une donnée de la plage source "B3:U7" est modifiée, pour obtenir ce résultat :
Seulement, il faut savoir qu'une fonction de calcul à deux contraintes :
- une modification dans la plage des données sources peut entraîner des appels qui vont se chevaucher sans laisser le temps à EXCEL de les gérer complètement, ce qui va faire planter le système ;
- une fonction de calcul ne peut modifier que la valeur de la cellule contenant la formule, et pas les autres cellules. Dans notre cas, la fonction de calcul est en cellules "X2", "Y2", "Z2", alors qu'il faut afficher le résultat du tri sous ces cellules, respectivement en "X3:X7", "Y3:Y7", "Z3:Z7".
Il va falloir ruser pour contourner ces deux obstacles :
- en stockant les éventuels appels successifs dans une structure qui reprendra les informations nécessaires au tri (plage source, colonne(s) à trier, colonne à retourner, plage où afficher le tri) mais n'effectuera pas le tri directement ;
- et en lançant le tri et la mise à jour de la plage destination plus tard, via une autre fonction.
Bob utilisera l'API SetTimer (voir le tome 2) pour différer ce traitement de 1/10e de seconde ce qui est suffisant pour stocker les différents appels reçus simultanément. Le traitement différé est désactivé avec l'API KillTimer.
L'en-tête du module contient les déclarations nécessaires :
'---------------------------------------------------------------------------------------
Declare
Function
KillTimer Lib
"user32"
(
ByVal
hwnd As
Long
, ByVal
nIDEvent As
Long
) As
Long
Declare
Function
SetTimer Lib
"user32"
(
ByVal
hwnd As
Long
, ByVal
nIDEvent As
Long
, _
ByVal
uElapse As
Long
, ByVal
lpTimerfunc As
Long
) As
Long
' Structure pour mémoriser les paramètres des appels:
Type
TypeTri
PlageDonnées As
Range
ColonneATrier As
String
PlageDestination As
Range
ColRetour As
Integer
Mémo As
String
End
Type
Dim
TriEnAttente
(
) As
TypeTri
' Mémorise le nombre d'appels en attente à traiter:
Dim
NbTriEnAttente As
Long
' Mémorise le pointeur obtenu avec SetTimer:
Dim
TimerTri As
Long
'-------------------------------------------------------------------------------
La fonction TriDynamique se contente de mémoriser les informations nécessaires au tri, et prépare l'appel à la fonction MiseAJourTri qui fera le reste du travail :
'---------------------------------------------------------------------------------------
Public
Function
TriDynamique
(
Titre As
String
, _
PlageDonnées As
Range, _
Optional
ColonneATrier As
String
=
"1"
, _
Optional
ColRetour As
String
=
"1"
, _
Optional
PlageDestination As
String
=
""
, _
Optional
AvecEnTete As
Boolean
=
False
) As
Variant
'---------------------------------------------------------------------------------------
' Titre: titre à afficher dans la cellule qui contient la formule (à la place de zéro).
' PlageDonnées: plage des données sources.
' ColonneATrier: numéro de la colonne dans la plage (de 1 à n) où sont les données à trier.
' si plusieurs colonnes, les séparer par un point-virgule.
' ColRetour: numéro de la colonne dans la plage (de 1 à n) où sont les valeurs à retourner.
' PlageDestination: cellule ou plage de destination (si vide = cellule sous la formule).
' AvecEnTete: indique si la plage source est avec un en-tête (Faux par défaut).
'---------------------------------------------------------------------------------------
Application.Volatile
False
' Appel à chaque changement d'une valeur dans "PlageDonnées".
On
Error
Resume
Next
' Ignore les erreurs.
TriDynamique =
Titre ' Affiche le titre de la cellule à la place de zéro.
' Si la destination est vide alors prend la cellule sous la formule:
If
PlageDestination =
""
Then
PlageDestination =
Application.Caller.Offset
(
1
, 0
).Address
' Incorpore le nom de la feuille à l'adresse de destination si elle n'y est pas:
If
InStr
(
1
, PlageDestination, "!"
) =
0
Then
_
PlageDestination =
Application.Caller.Worksheet.Name
&
"!"
&
PlageDestination
' Supprime les $ dans la PlageDestination:
PlageDestination =
Replace
(
PlageDestination, "$"
, ""
)
' Vérifie que la demande de mise à jour n'a pas déjà été mise en attente:
Dim
i As
Long
For
i =
1
To
NbTriEnAttente
If
TriEnAttente
(
i).Mémo
=
PlageDestination Then
Exit
Function
Next
i
' Modifie la plage source s'il y a un en-tête (et reprend l'en-tête si le titre est vide):
If
AvecEnTete =
True
Then
If
Titre =
""
Then
TriDynamique =
PlageDonnées
(
1
, 1
).Value
Set
PlageDonnées =
PlageDonnées.Resize
(
PlageDonnées.Rows.Count
-
1
, _
PlageDonnées.Columns.Count
)
Set
PlageDonnées =
PlageDonnées.Offset
(
1
, 0
)
End
If
' Mémorise les paramètres de l'appel dans une structure pour un traitement ultérieur:
NbTriEnAttente =
NbTriEnAttente +
1
ReDim
Preserve
TriEnAttente
(
NbTriEnAttente)
Set
TriEnAttente
(
NbTriEnAttente).PlageDonnées
=
PlageDonnées
TriEnAttente
(
NbTriEnAttente).ColonneATrier
=
ColonneATrier
Set
TriEnAttente
(
NbTriEnAttente).PlageDestination
=
Range
(
PlageDestination)
TriEnAttente
(
NbTriEnAttente).ColRetour
=
ColRetour
TriEnAttente
(
NbTriEnAttente).Mémo
=
PlageDestination
' Décale de 100 millisecondes le traitement de mise à jour de la feuille.
If
NbTriEnAttente =
1
Then
TimerTri =
SetTimer
(
0
, 0
, 100
, AddressOf MiseAJourTri)
End
Function
'---------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------
Private
Sub
MiseAJourTri
(
)
'---------------------------------------------------------------------------------------
Call
KillTimer
(
0
, TimerTri) ' Supprime la gestion du traitement différé.
Application.Cursor
=
xlWait ' Curseur sablier.
Dim
DataRange As
Variant
, DataSource As
Variant
, DataDest As
Variant
Dim
TabDonnées
(
) As
Variant
, Classement
(
) As
Long
Dim
PlageTri As
Variant
, ColTri As
Integer
, NbCol As
Integer
Dim
n As
Integer
, i As
Long
, Ligne As
Long
, Num As
Long
, y As
Long
Dim
Isect As
Range
Dim
AncCalculation As
XlCalculation, AncEnableEvents As
Boolean
' Mémorise le mode de calcul et la gestion des événements:
AncCalculation =
Application.Calculation
AncEnableEvents =
Application.EnableEvents
Application.ScreenUpdating
=
False
' Boucle sur les traitements en attente:
On
Error
Resume
Next
For
Num =
1
To
NbTriEnAttente
' Mémorise les données des plages:
DataSource =
TriEnAttente
(
Num).PlageDonnées.Value
DataRange =
TriEnAttente
(
Num).PlageDonnées.Value
DataDest =
TriEnAttente
(
Num).PlageDonnées.Value
' Retrouve le nombre de lignes et de colonnes de la plage source:
Ligne =
UBound
(
DataSource): NbCol =
TriEnAttente
(
Num).PlageDonnées.Columns.Count
' Ne prend pas les dernières lignes vides du tableau:
Do
For
i =
1
To
NbCol
If
DataSource
(
Ligne, i) <>
""
Then
Exit
Do
Next
i
Ligne =
Ligne -
1
Loop
While
Ligne >
1
' Dimensionne la mémoire qui servira à mémoriser les données à trier:
ReDim
TabDonnées
(
0
To
Ligne -
1
)
' Boucle sur les colonnes de tri (séparées par une virgule ou un point-virgule):
TriEnAttente
(
Num).ColonneATrier
=
Replace
(
TriEnAttente
(
Num).ColonneATrier
, " "
, ""
)
TriEnAttente
(
Num).ColonneATrier
=
Replace
(
TriEnAttente
(
Num).ColonneATrier
, ","
, ";"
)
PlageTri =
Split
(
TriEnAttente
(
Num).ColonneATrier
, ";"
)
For
ColTri =
UBound
(
PlageTri) To
0
Step
-
1
' Lecture des données pour alimenter la variable utilisée par QuickRanking:
For
i =
1
To
Ligne
TabDonnées
(
i -
1
) =
DataRange
(
i, Abs
(
Int
(
PlageTri
(
ColTri))))
If
TabDonnées
(
i -
1
) =
""
Then
TabDonnées
(
i -
1
) =
Chr
(
1
)
Next
i
' Calcule le classement avec QuickRanking (respecte l'ordre d'origine si égalité):
If
PlageTri
(
ColTri) >
0
Then
Classement
(
) =
QuickRanking
(
TabDonnées, True
, 2
) ' Croissant si colonne > 0.
Else
Classement
(
) =
QuickRanking
(
TabDonnées, False
, 2
) ' Décroissant si colonne < 0.
End
If
' Mise à jour des données en mémoire DataRange d'après DataSource:
For
i =
0
To
UBound
(
TabDonnées)
y =
Classement
(
i)
For
n =
1
To
NbCol
DataRange
(
y, n) =
DataSource
(
i +
1
, n)
Next
n
Next
i
' Mise à jour des données en mémoire DataSource:
DataSource =
DataRange
Next
ColTri
' Si une seule cellule destination ou si la destination est plus grande que la source,
' alors étend la destination à la taille des données sources:
If
TriEnAttente
(
Num).PlageDestination.Rows.Count
=
1
Or
_
TriEnAttente
(
Num).PlageDestination.Rows.Count
>
TriEnAttente
(
Num).PlageDonnées.Rows.Count
_
Then
_
Set
TriEnAttente
(
Num).PlageDestination
=
_
TriEnAttente
(
Num).PlageDestination.Resize
(
Ligne, 1
)
' Mise à jour des données en mémoire DataDest d'après DataRange:
For
i =
1
To
TriEnAttente
(
Num).PlageDestination.Count
DataDest
(
i, 1
) =
DataRange
(
i, TriEnAttente
(
Num).ColRetour
)
Next
i
' Vérifie s'il y a une intersection entre la source et la destination:
Set
Isect =
Application.Intersect
(
TriEnAttente
(
Num).PlageDonnées
, _
TriEnAttente
(
Num).PlageDestination
)
' S'il n'y a pas d'intersection alors fait la mise à jour de la destination:
If
Isect Is
Nothing
=
True
Then
With
ThisWorkbook.Worksheets
(
TriEnAttente
(
Num).PlageDestination.Worksheet.Name
)
.Range
(
TriEnAttente
(
Num).PlageDestination.Address
).Value
=
DataDest
End
With
End
If
Next
Num
' Fin du traitement:
Application.ScreenUpdating
=
True
Application.Cursor
=
xlDefault
Application.Calculation
=
AncCalculation
Application.EnableEvents
=
AncEnableEvents
NbTriEnAttente =
0
End
Sub
'---------------------------------------------------------------------------------------
Après avoir supprimé le bonus dans les formules de calcul des points afin d'accepter la situation où des joueurs sont ex aequo, voici comment Alice va modifier son tableau :
- "X2" =TriDynamique ("Nom"; B3:U7; "20,1"; "2"; "X3") dans la plage "B3:U7", trie d'après la 20e colonne (les points) et la 1re (l'ordre des joueurs), et retourne la 2e colonne (les noms) de "X3" jusqu'à "X7". La cellule prend comme libellé « Nom »;
- "Y2" =TriDynamique ("Points"; B3:U7; "20,1"; "19"; "Y3") même tri mais retourne les points ;
- "Z2" =TriDynamique ("Clasmt"; B3:U7; "20,1"; "20"; "Z3") même tri mais retourne le classement ;
- "W3" =SI(ESTERREUR(CHOISIR(Z3;"Or";"Argent";"Bronze"));"";CHOISIR(Z3;"Or";"Argent";"Bronze")) formule qui est recopiée jusqu'en "W7".
Tout simplement.
Dernières remarques :
- la plage destination est au format texte (String), parce qu'il n'est pas possible d'utiliser un format Range, en effet cela relancerait le tri dès que la plage destination est modifiée, soit une référence circulaire ;
- le tri peut porter sur plusieurs colonnes, séparées par une virgule ou un point-virgule à l'intérieur du même double guillemet de l'argument « ColonneATrier » ;
- pour trier une colonne par ordre décroissant, faites précéder son numéro par le signe moins ;
- si la plage destination reste vide, alors la cellule sous la formule est prise par défaut ;
- si la plage destination ne représente qu'une seule cellule alors la plage est étendue automatiquement à la taille de la plage des données sources ;
- si la plage destination est plus petite que la plage source, seules les données pouvant rentrer dans la plage destination sont retournées ;
- si la plage source a un en-tête à ne pas reprendre dans le tri, alors indiquez VRAI au dernier argument « AvecEnTete ». Dans ce cas, si le titre est à vide, c'est le libellé de l'en-tête qui est repris ;
- si la plage source est sur une feuille différente de la plage destination, vous devez indiquer le nom de la feuille concernée dans la formule.
Par exemple =TriDynamique ("";Flechettes!C2:C7; ; ; ; VRAI) pour afficher la liste triée des joueurs dans le cas où la source est sur la feuille « Flechettes » et la formule dans une autre feuille.
V. Entracte▲
Après cette longue lecture, vous méritez un intermède musical. Alice va vous interpréter une chanson de Renaud Sechan, dont vous connaissez bien la mélodie :
À m'asseoir sur un banc cinq minutes avec toi
Et regarder les gens tant qu'y en a
Te parler du bon temps qu'est mort ou qui r'viendra
En serrant dans ma main tes p'tits doigts
Pi donner à bouffer à des pigeons idiots
Leur filer des coups d'pied pour de faux
Et entendre ton rire qui lézarde les murs
Qui sait surtout guérir mes blessures
Te raconter un peu comment j'étais, mino
Les bombecs fabuleux qu'on piquait chez l'marchand
Car-en-sac et Mintho caramels à un franc
Et les Mistral gagnants
À marcher sous la pluie cinq minutes avec toi
Et regarder la vie tant qu'y en a
Te raconter la terre en te bouffant des yeux
Te parler de ta mère un p'tit peu
Et sauter dans les flaques pour la faire râler
Bousiller nos godasses et s'marrer
Et entendre ton rire comme on entend la mer
S'arrêter, repartir en arrière
Te raconter surtout les carambars d'antan et les coco-boers
Et les vrais roudoudous qui nous coupaient les lèvres et nous niquaient les dents
Et les Mistral gagnants
À m'asseoir sur un banc cinq minutes avec toi
Regarder le soleil qui s'en va
Te parler du bon temps qu'est mort et je m'en fous
Te dire que les méchants c'est pas nous
Que si moi je suis barge ce n'est que de tes yeux
Car ils ont l'avantage d'être deux
Et entendre ton rire s'envoler aussi haut
Que s'envolent les cris des oiseaux
Te raconter enfin qu'il faut aimer la vie et l'aimer même si
Le temps est assassin et emporte avec lui
Les rires des enfants et les mistral gagnants
Et les mistral gagnants
- J'aime cette chanson. Sais-tu qu'elle a plus de trente ans ? demanda Alice. Penses-tu qu'on la chantera encore dans trente ans ?
- Oui, c'est certain, elle est tellement belle qu'elle sera transmise sur quelques générations avant d'être oubliée.
VI. Acte II - Scène I▲
Un soir Alice a demandé à Bob. « Si j'étais une ligne de programmation, je serais laquelle ? » Bob a répondu : « i = 1 - i ». Alice n'a pas compris, puis s'est endormie.
Bob n'est pas tombé dans les bras de Morphée avant d'avoir trouvé une solution à son problème. Qui n'a jamais été confronté au casse-tête que représente la saisie d'une date dans EXCEL, dès lors qu'il faut prendre en compte les jours fériés ?
En France (mais cette fois ce n'est pas une exception culturelle) les jours fériés appartiennent à deux catégories :
- les fêtes fixes, qui tombent toujours le même jour, comme le 14 juillet ;
- les fêtes mobiles, qui varient d'une année à l'autre. Mais pourquoi varient-elles ? Parce qu'elles prennent toutes comme référence le dimanche de Pâques, comme l'Ascension qui est 39 jours après Pâques. Et vous avez dû le remarquer, le dimanche de Pâques n'est pas fixe. Cette définition tirée du dictionnaire Larousse nous explique pourquoi :
« La fête de Pâques a été fixée par le concile de Nicée (325 après J.-C.) au premier dimanche après la pleine lune qui a lieu soit le jour de l'équinoxe de printemps (21 mars), soit aussitôt après cette date. Pâques est donc au plus tôt le 22 mars. Si la pleine lune tombe le 20 mars, la suivante sera le 18 avril (29 jours après). Si ce jour est un dimanche, Pâques sera le 25 avril. Ainsi, la fête de Pâques oscille entre le 22 mars et le 25 avril, et de sa date dépendent celles des autres fêtes mobiles.
Ça promet de sacrés calculs pour retrouver le dimanche de Pâques d'une année donnée, alors si comme moi vous êtes aussi nul en maths qu'en astronomie, je vous conseille de récupérer les travaux du mathématicien Thomas O'Beirne :
Soit M l'année du calcul :
- on pose n = M - 1900 ;
- on prend a, le reste de n dans la division par 19 ;
- on calcule a × 7 + 1 ;
- on en prend b, le résultat entier de la division par 19 ;
- on calcule (11 × a) - b + 4 ;
- on en prend c le reste de la division par 29 ;
- on calcule d la partie entière de n / 4 ;
- on calcule n - c + d + 31 ;
- on en prend e le reste de la division par 7 ;
- on calcule P = 25 - c - e ;
- la date de Pâques tombe P jours après le 31 mars (ou avant si P est négatif).
Cet algorithme est certifié pour les années 1901 à 2099, ce qui vous laisse un peu de temps pour l'améliorer. Et pour le besoin de l'exemple que nous allons étudier, il nous suffira.
Dans cet exemple nous allons ajouter une 3e catégorie de jours fériés : les jours « exceptionnels ». Soit les jours d'une année précise, qui représentent par exemple un pont où votre entreprise est fermée, ou vos congés.
Pour compléter l'exercice, nous devons exclure aussi les jours de la semaine où Alice ne travaille pas, soit les samedis et les dimanches.
Pour contrôler la validité d'une date saisie par l'utilisateur, le plus simple est de créer une fonction de calcul comme cela a été fait avec RechercheW, qui retourne VRAI ou FAUX suivant que la saisie est admise ou non, et qui sera facilement utilisable par Alice.
La fonction de calcul ControleDate prend en arguments :
- la cellule contenant la date saisie ;
-
la liste des jours exclus. Cette liste peut être entrée en dur au format texte, c'est-à-dire entre guillemets, où chaque élément est séparé par une virgule ou un point-virgule (les deux sont admis), ou bien faire référence à une plage de données qui contient les éléments en question, à savoir :
- pour exclure un jour de semaine, indiquez ses trois premières lettres (ou le jour complet) : LUN pour lundi, MAR pour mardi, MER pour mercredi, etc.,
- pour exclure une date fixe, indiquez le jour, le signe « / », et le mois, au format « 0/0 » ou « 00/00 », ce qui donne « 1/1 » ou « 01/01 » pour le premier janvier,
- pour exclure un jour exceptionnel, indiquez ce jour au format « 0/0/0000 » ou « 00/00/0000 », donc « 2/1/2018 » ou « 02/01/2018 » pour le 2 janvier 2018,
- pour exclure une date mobile, indiquez l'écart (positif ou négatif, mais non nul) entre cette date et le dimanche de Pâques, soit « 39 » pour l'Ascension ;
- il n'y a pas d'ordre précis à respecter dans la présentation de ces éléments ;
- un drapeau optionnel, VRAI ou FAUX (par défaut), qui indique s'il faut afficher un message en cas de saisie d'une date non admise ;
- en option, la valeur (ou le texte) à retourner si la date saisie est admise, VRAI par défaut ;
- en option, la valeur (ou le texte) à retourner si la date saisie n'est pas admise, FAUX par défaut.
La fonction retourne une chaîne vide si la saisie est vide.
Par exemple, pour exclure les samedis et dimanches, le jour de l'an, la fête du travail, la victoire 1945, la fête nationale, l'Assomption, la Toussaint, l'armistice 1918, Noël, le lundi de Pâques, l'Ascension, le lundi de Pentecôte et le pont du 24 décembre 2018 (merci patron), en affichant un message en cas de saisie d'une date non admise, la formule en "C1" est =ControleDate(B1; "SAM, DIM, 1/1, 1/5, 8/5, 14/7, 15/8, 1/11, 11/11, 25/12, 1, 39, 50, 24/12/2018"; VRAI).
Ce qui donne :
Ou bien =ControleDate(B1; F1:F14; VRAI) :
Attention, mettez une apostrophe devant les fêtes fixes pour avoir du texte, sinon EXCEL risque de transformer votre saisie en une date de l'année en cours. Ici en "F1" : '1/1.
Dans la pratique, cette liste des jours à exclure se trouvera souvent sur une autre feuille. Vous pouvez aussi la nommer et utiliser ce nom dans la formule. La possibilité de paramétrer les jours exclus permet d'adapter facilement cette fonction à vos besoins.
Vous pouvez compléter les règles de validation des saisies avec le menu « Données / Validation des données », et n'oubliez pas la mise en forme conditionnelle pour signaler les erreurs de saisie. Exemple pour la cellule "B1" :
'---------------------------------------------------------------------------------------
Public
Function
ControleDate
(
CelluleSource As
Range, _
JoursExclus As
Variant
, _
Optional
MessageSiErreur As
Boolean
=
False
, _
Optional
TexteSiAdmis As
Variant
=
True
, _
Optional
TexteSiNonAdmis As
Variant
=
False
) As
Variant
'---------------------------------------------------------------------------------------
Dim
JrSem As
Integer
, Message As
String
, i As
Long
, Paques As
Long
Dim
MaCellule As
Range, LibJrSem As
Variant
Dim
LibJoursExclus As
String
, TabJoursExclus As
Variant
Application.Volatile
False
ControleDate =
TexteSiNonAdmis
' Transforme les jours exclus en tableau:
Select
Case
TypeName
(
JoursExclus)
Case
"Range"
' Boucle sur les cellules non vides:
For
Each
MaCellule In
JoursExclus.SpecialCells
(
xlCellTypeConstants)
LibJoursExclus =
LibJoursExclus &
UCase
(
MaCellule.Value
) &
","
Next
LibJoursExclus =
Left
(
LibJoursExclus, Len
(
LibJoursExclus) -
1
)
Case
"String"
LibJoursExclus =
UCase
(
JoursExclus)
End
Select
LibJoursExclus =
Replace
(
LibJoursExclus, " "
, ""
) ' Supprime les espaces.
LibJoursExclus =
Replace
(
LibJoursExclus, ";"
, ","
) ' Remplace ";" par ",".
TabJoursExclus =
Split
(
LibJoursExclus, ","
) ' Création du Tableau.
' Vérifie que la saisie corresponde à une valeur date et est au format date:
If
IsDate
(
CelluleSource) =
True
And
CelluleSource Like "##/##/####"
Then
' Détermine le jour de la semaine de cette date:
' 1=Dim, 2=Lun, 3=Mar, 4=Mer, 5=Jeu, 6=Ven, 7=Sam
LibJrSem =
Array
(
""
, "DIM"
, "LUN"
, "MAR"
, "MER"
, "JEU"
, "VEN"
, "SAM"
)
JrSem =
Weekday
(
CelluleSource, vbSunday)
' Si certains jours de la semaine sont exclus des saisies possibles:
If
InStr
(
1
, LibJoursExclus, LibJrSem
(
JrSem), vbTextCompare) >
0
Then
Message =
"Vous ne pouvez pas saisir une date sur ce jour de la semaine: "
_
&
Format
(
CelluleSource, "dddd"
)
' Analyse les autres cas possibles des jours à exclure:
Else
' Calcule la date de pâque pour l'année de la date:
Paques =
CalculPaquesThomasOBeirne
(
Year
(
CelluleSource))
' Boucle sur les jours exclus:
For
i =
0
To
UBound
(
TabJoursExclus)
' Dates jour + mois:
If
TabJoursExclus
(
i) =
Day
(
CelluleSource) &
"/"
&
Month
(
CelluleSource) _
Or
TabJoursExclus
(
i) =
Format
(
Day
(
CelluleSource), "00"
) &
_
"/"
&
Format
(
Month
(
CelluleSource), "00"
) Then
Message =
"Vous ne pouvez pas saisir une date sur un jour férié"
Exit
For
End
If
' Dates jour + mois + année:
If
TabJoursExclus
(
i) =
Day
(
CelluleSource) &
"/"
&
Month
(
CelluleSource) &
"/"
_
&
Year
(
CelluleSource) Or
_
TabJoursExclus
(
i) =
Format
(
Day
(
CelluleSource), "00"
) &
"/"
&
_
Format
(
Month
(
CelluleSource), "00"
) &
"/"
&
Year
(
CelluleSource) Then
Message =
"Vous ne pouvez pas saisir une date sur ce jour"
Exit
For
End
If
' Jours de pâques et fêtes mobiles (si le jour exclu n'a pas "/"):
If
InStr
(
1
, TabJoursExclus
(
i), "/"
) =
0
And
Val
(
TabJoursExclus
(
i)) <>
0
Then
If
Paques +
Val
(
TabJoursExclus
(
i)) =
DateValue
(
CelluleSource) Then
Message =
"Vous ne pouvez pas saisir une date sur un jour férié"
Exit
For
End
If
End
If
Next
i
End
If
' Sinon si la saisie n'est pas une date alors affiche un message:
ElseIf
CelluleSource >
""
Then
_
Message =
"Vous devez saisir une date au format: jour/mois/année"
End
If
' Si pas d'erreur alors retourne TexteSiAdmis (VRAI par défaut):
If
Message =
""
Then
ControleDate =
TexteSiAdmis
' S'il faut afficher un message alors l'affiche:
ElseIf
MessageSiErreur =
True
And
ActiveSheet.Name
=
Application.Caller.Worksheet.Name
Then
MsgBox
"Votre saisie: "
&
CelluleSource _
&
Chr
(
10
) &
Chr
(
13
) &
Chr
(
13
) &
Message &
"."
, vbCritical
+
vbOKOnly
End
If
' Si la cellule est vide alors retourne un vide:
If
CelluleSource =
""
Then
ControleDate =
""
End
Function
'---------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------
Public
Function
CalculPaquesThomasOBeirne
(
f_Annee As
Long
) As
Long
'---------------------------------------------------------------------------------------
' Formule de Thomas O'Beirne certifiée de 1901 à 2099. (Int non nécessaire sur des entiers)
'---------------------------------------------------------------------------------------
Dim
N, A, B, C, D, E, P As
Integer
N =
f_Annee -
1900
A =
f_Annee Mod
19
B =
Int
((
A *
7
+
1
) /
19
)
C =
((
11
*
A) -
B +
4
) Mod
29
D =
Int
(
N /
4
)
E =
(
N -
C +
D +
31
) Mod
7
P =
25
-
C -
E
CalculPaquesThomasOBeirne =
DateSerial
(
f_Annee, 3
, 31
+
P)
End
Function
'---------------------------------------------------------------------------------------
VII. Acte II - Scène II▲
Nous venons de voir comment contrôler facilement la saisie d'une date en tenant compte de jours à exclure. Sur le même principe, il est tout aussi utile de pouvoir gérer la validité d'une saisie dans EXCEL par rapport à un format attendu.
La fonction de calcul qui suit va utiliser la puissance de l'opérateur Like en VBA. Je vous invite à consulter l'aide pour bien comprendre la syntaxe à respecter pour comparer « une chaîne à un modèle ».
Ce qu'il faut retenir concernant le modèle des saisies admises :
- si le modèle contient un caractère unique, celui-ci doit être inclus dans la chaîne, et à la position demandée, "CA" Like "CB" renvoie FAUX car si le premier caractère de la chaîne est bien un "C" le second n'est pas le "B" attendu par le modèle, et "CBA" Like "CB" renvoie FAUX car deux caractères seulement sont attendus par le modèle alors que la chaîne en contient trois ;
- le point d'interrogation remplace n'importe quel caractère, "CAT" Like "C?T" renvoie VRAI car tous les caractères sont admis à la deuxième position de la chaîne ;
- l'étoile remplace tous les caractères suivants, "CBA" Like "CB*" renvoie VRAI (car le modèle attend une chaîne commençant par "CB" de deux caractères ou plus) donc "CBA" Like "*" renvoie toujours VRAI et n'a guère d'intérêt (sauf d'autoriser toutes les saisies) ;
- le croisillon #, remplace tout chiffre entre 0 et 9, "123" Like "###" renvoie VRAI, car trois chiffres sont attendus dans la chaîne ;
- si plusieurs caractères sont admis pour une position il faut les mettre entre crochets, "AE" Like "[ABC][EF]" renvoie VRAI car "A", "B", ou "C", sont admis en 1re position, et "E" ou "F" en seconde ;
- une plage de caractères est entre crochets et est séparée par un trait d'union, "C" Like "[A-Z]" renvoie VRAI car il est attendu un caractère compris entre "A" et "Z", et "0" Like "[A-Z0-9x]" renvoie VRAI car est admis soit un caractère entre "A" et "Z", soit entre "0" et "9", soit un "x" ;
- n'insérez pas d'espace entre les différentes plages, sauf pour indiquer que l'espace est un caractère admis ;
- les caractères spéciaux (point d'interrogation, croisillon, étoile) dans les crochets sont considérés comme des caractères ordinaires, Like "[A-Z#]" sera interprété comme entre "A" et "Z", ou "#" ;
- il est préférable d'avoir sous la main une table des jeux de caractères pour bien configurer les plages, voir l'aide aux rubriques « Jeu de caractères (0 à 127) » et « Jeu de caractères (128 à 255) » ;
- toutes ces conditions peuvent se cumuler pour former un modèle complexe.
Des exemples :
"Fr-xx9"
Like"[A-Z][a-z]-[0-9x][0-9x][0-9]"
= VRAI"xx-12-34-56-78"
Like"[0-9x][0-9x]-[0-9][0-9]-[0-9][0-9]-[0-9][0-9]-[0-9][0-9]"
= VRAI"FR9 Tester"
Like"[A-Z][A-Z]#*er"
= VRAI"é"
Like"[A-Za-zÀ-ÿ' -]"
= VRAI"TOTO"
Like"[A-Z][A-Z ][A-Z ][A-Z ][A-Z ][A-Z ]"
= FAUX
Le dernier exemple met en exergue les limites de l'opérateur Like :
- dans le modèle six caractères sont attendus, le premier compris entre "A" et "Z", les cinq autres compris entre "A" et "Z", ou espace, alors que la chaîne n'en contient que quatre. L'utilisateur doit donc compléter sa saisie de deux espaces pour qu'elle soit valide ;
- les cinq derniers caractères
"[A-Z ]"
sont des répétitions, il serait plus lisible de n'écrire qu'une fois"[A-Z ]"
et d'indiquer qu'il faut le répéter pour en obtenir cinq.
Bob a plus d'un tour dans son sac et pour remédier à ces deux contraintes, sa fonction :
- complète virtuellement la chaîne d'espaces pour vérifier sa conformité au modèle, ainsi la chaîne "TOTO" retourne VRAI avec le modèle
"[A-Z][A-Z ][A-Z ][A-Z ][A-Z ][A-Z ]"
; - procède à la répétition d'une plage entre crochets n fois si « [*n] » est trouvé dans le modèle. Dans ce cas, toutes les conditions du modèle doivent être entre crochets.
Le modèle pour la chaîne"FR-999"
qui était"[A-Z][A-Z]-###"
devient"[A-Z][*2][-][#][*3]"
.
Les arguments de la fonction ControleFormat sont :
- la cellule contenant la saisie ;
- le modèle admis qui peut être entré en dur au format texte, c'est-à-dire entre guillemets, ou bien faire référence à une cellule ;
- un drapeau optionnel, VRAI ou FAUX (par défaut), qui indique s'il faut afficher un message en cas de saisie non conforme ;
- en option, la valeur (ou le texte) à retourner si la saisie est conforme, VRAI par défaut ;
- en option, la valeur (ou le texte) à retourner si la saisie n'est pas conforme, FAUX par défaut.
La fonction retourne une chaîne vide si la saisie est vide.
Pensez à inclure l'instruction Option Compare Binary dans l'en-tête du module pour rendre "A" différent de "a" pour l'opérateur Like.
'---------------------------------------------------------------------------------------
Public
Function
ControleFormat
(
CelluleSource As
Range, _
FormatAdmis As
Variant
, _
Optional
MessageSiErreur As
Boolean
=
False
, _
Optional
TexteSiAdmis As
Variant
=
True
, _
Optional
TexteSiNonAdmis As
Variant
=
False
) As
Variant
'---------------------------------------------------------------------------------------
Dim
Message As
String
, FormatCorrigé As
String
, Espace As
String
Application.Volatile
False
ControleFormat =
TexteSiNonAdmis
' Corrige le format admis pour qu'il soit reconnaissable par "Like":
FormatCorrigé =
CorrigeFormatAdmis
(
FormatAdmis)
' Vérifie que la cellule est non vide:
If
CelluleSource <>
""
Then
Message =
"N'est pas au format admis: "
&
FormatAdmis
Do
' Si le format est admis alors retourne TexteSiAdmis (VRAI par défaut):
If
CelluleSource &
Espace Like FormatCorrigé Then
ControleFormat =
TexteSiAdmis
Message =
""
Exit
Do
End
If
Espace =
Espace &
" "
Loop
While
Len
(
Espace) +
Len
(
CelluleSource) <=
Len
(
FormatCorrigé)
End
If
If
MessageSiErreur =
True
And
Message >
""
_
And
ActiveSheet.Name
=
Application.Caller.Worksheet.Name
Then
MsgBox
"Votre saisie : "
&
CelluleSource _
&
Chr
(
10
) &
Chr
(
13
) &
Chr
(
13
) &
Message, vbCritical
+
vbOKOnly
End
If
' Si la cellule est vide alors retourne un vide:
If
CelluleSource =
""
Then
ControleFormat =
""
End
Function
'---------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------
Private
Function
CorrigeFormatAdmis
(
ByVal
FormatAdmis As
String
) As
String
'---------------------------------------------------------------------------------------
Dim
Tps
(
) As
String
, Ajout As
String
, i As
Integer
, ik As
Integer
' Si le format admis contient des répétitions, càd [*n] où n est un chiffre:
If
InStr
(
1
, FormatAdmis, "[*"
) >
0
Then
' Place le format de saisie dans un tableau avec comme délimiteur "[":
Tps =
Split
(
FormatAdmis, "["
)
' Boucle sur le tableau pour rajouter le crochet ouvrant qui a été supprimé:
For
i =
1
To
UBound
(
Tps)
Tps
(
i) =
"["
&
Tps
(
i)
' Si format = Crochet ouvrant + caractère + Crochet fermant alors
' ne retient que le caractère entre ces crochets:
If
Len
(
Tps
(
i)) =
3
Then
Tps
(
i) =
Mid
(
Tps
(
i), 2
, 1
)
Next
i
' Boucle sur le tableau pour trouver des [*n] où n est un chiffre:
FormatAdmis =
""
For
i =
1
To
UBound
(
Tps)
Ajout =
""
' S'il faut faire une répétition [*n]:
If
InStr
(
1
, Tps
(
i), "[*"
) >
0
Then
' Retrouve le nombre de répétitions à faire:
Tps
(
i) =
Replace
(
Tps
(
i), "[*"
, ""
)
Tps
(
i) =
Replace
(
Tps
(
i), "]"
, ""
)
' Fait la répétition du format précédent:
For
ik =
1
To
Val
(
Tps
(
i)) -
1
Ajout =
Ajout &
Tps
(
i -
1
)
Next
ik
' Sinon prend le format en cours:
Else
Ajout =
Tps
(
i)
End
If
' Ajoute le format corrigé à la suite du format:
FormatAdmis =
FormatAdmis &
Ajout
Next
i
End
If
' Retourne le format admis (éventuellement corrigé):
CorrigeFormatAdmis =
FormatAdmis
End
Function
'---------------------------------------------------------------------------------------
Quelques astuces en complément de cette fonction :
- vous pouvez nommer une cellule qui contient (sur une feuille de configuration) un modèle de saisie admise et utiliser ce nom dans la formule ;
- vous pouvez compléter les règles de validation des saisies avec le menu « Données / Validation des données » ;
- vous pouvez utiliser la mise en forme conditionnelle des cellules pour signaler les erreurs de saisie.
VIII. Acte II - Scène III▲
Pour enregistrer les paramètres utilisés par nos fonctions en VBA, nous utilisons souvent une feuille de calcul. Comme ici pour indiquer le répertoire qui accueillera les sauvegardes, en cellule "B1" qui est renommée « CheminSauvegarde » :
Sub
SauvegarderCeFichier
(
)
RépertoireDest =
[CheminSauvegarde].Value
' Ou plus classique: Range("CheminSauvegarde").Value
If
RépertoireDest <>
""
Then
ThisWorkbook.SaveAs
RépertoireDest &
ThisWorkbook.Name
End
Sub
Savez-vous qu'il existe deux autres façons de faire ?
La première méthode utilise les propriétés personnalisées du classeur, ce qui peut sembler évident car elles sont faites pour cela. Ce qui est surprenant, c'est plutôt qu'elles soient si peu utilisées…
(Je me permets d'interrompre Bob avant qu'il ne vous lasse, car ce qu'il a à dire est moins important qu'il ne le pense. Avançons le temps et retrouvons-le lorsqu'il aborde la manipulation desdites propriétés).
Pour créer une propriété personnelle dans le classeur actif, nous utiliserons :
ActiveWorkbook.CustomDocumentProperties.Add
Avec les arguments suivants :
- Name : est le nom de la propriété, ici « CheminSauvegarde » ;
- Value : est la valeur de la propriété, ici « C:\Mes_Sauvegardes\ » ;
-
Type : est le format de cette valeur :
- msoPropertyTypeBoolean = une valeur booléenne VRAI/FAUX,
- msoPropertyTypeDate = une date,
- msoPropertyTypeFloat = un nombre à virgule flottante,
- msoPropertyTypeNumber = un nombre entier,
- msoPropertyTypeString = une chaîne (attention, 255 caractères maximum) ;
- LinkToContent : est toujours à FAUX dans notre cas.
ActiveWorkbook.CustomDocumentProperties.Item
(
NomPropriété).Value
Où NomPropriété est le nom de la propriété concernée, ici « CheminSauvegarde ».
Et sur le même principe, pour supprimer une propriété personnelle dans le classeur actif, nous exécuterons :
ActiveWorkbook.CustomDocumentProperties.Item
(
NomPropriété).Delete
Où NomPropriété est le nom de la propriété concernée, ici « CheminSauvegarde ».
Ce qui donne les fonctions suivantes :
'---------------------------------------------------------------------------------------
Public
Function
PropriétéEcrire
(
NomPropriété As
String
, ValPropriété As
Variant
, _
Optional
TypePropriété As
MsoDocProperties =
msoPropertyTypeString) As
Boolean
'-------------------------------------------------------------------------------
' Écrit la propriété NomPropriété avec la valeur ValPropriété au format String par défaut
' dans le classeur actif.
'-------------------------------------------------------------------------------
On
Error
GoTo
Gest_Err
' Supprime la propriété si elle existe déjà:
Call
PropriétéSupprimer
(
NomPropriété)
' Crée la propriété et retourne True si tout se passe bien:
ActiveWorkbook.CustomDocumentProperties.Add
Name:=
NomPropriété, Value:=
ValPropriété, _
Type
:=
TypePropriété, LinkToContent:=
False
PropriétéEcrire =
True
' Efface les erreurs:
Gest_Err
:
Err
.Clear
End
Function
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
Public
Function
PropriétéLire
(
NomPropriété As
String
) As
Variant
'-------------------------------------------------------------------------------
' Lit la propriété NomPropriété dans le classeur actif et retourne sa valeur.
'-------------------------------------------------------------------------------
On
Error
GoTo
Gest_Err
' Lit la propriété:
PropriétéLire =
ActiveWorkbook.CustomDocumentProperties.Item
(
NomPropriété).Value
' Efface les erreurs:
Gest_Err
:
Err
.Clear
End
Function
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
Public
Function
PropriétéSupprimer
(
NomPropriété As
String
) As
Boolean
'-------------------------------------------------------------------------------
' Supprime la propriété NomPropriété dans le classeur actif,
' ou toutes les propriétés si NomPropriété = ""
'-------------------------------------------------------------------------------
Dim
p As
DocumentProperty
On
Error
GoTo
Gest_Err
If
NomPropriété <>
""
Then
ActiveWorkbook.CustomDocumentProperties.Item
(
NomPropriété).Delete
Else
' Boucle sur les propriétés du classeur actif:
For
Each
p In
ActiveWorkbook.CustomDocumentProperties
ActiveWorkbook.CustomDocumentProperties.Item
(
p.Name
).Delete
Next
End
If
PropriétéSupprimer =
True
' Efface les erreurs:
Gest_Err
:
Err
.Clear
End
Function
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
Public
Function
PropriétéLister
(
ByRef
NomPropriété As
Variant
, _
ByRef
ValPropriété As
Variant
) As
Boolean
'-------------------------------------------------------------------------------
' Retourne la liste des propriétés, du classeur actif, dans les variables
' NomPropriété et ValPropriété, à déclarer ainsi:
' Dim NomPropriété() As Variant, ValPropriété() As Variant.
'-------------------------------------------------------------------------------
Dim
p As
DocumentProperty, i As
Integer
On
Error
GoTo
Gest_Err
' Boucle sur les propriétés du classeur actif:
For
Each
p In
ActiveWorkbook.CustomDocumentProperties
ReDim
Preserve
NomPropriété
(
i) ' Redimensionne la mémoire.
ReDim
Preserve
ValPropriété
(
i) ' Redimensionne la mémoire.
NomPropriété
(
i) =
p.Name
' Mémorise le Nom de la propriété.
ValPropriété
(
i) =
p.Value
' Mémorise la Valeur de la propriété.
i =
i +
1
' Élément suivant
Next
PropriétéLister =
True
' Efface les erreurs:
Gest_Err
:
Err
.Clear
End
Function
'---------------------------------------------------------------------------------------
À utiliser ainsi pour initialiser la propriété « CheminSauvegarde » , et l'utiliser lors d'une sauvegarde du fichier actif :
Sub
Initialisation
(
)
Call
PropriétéEcrire
(
"CheminSauvegarde"
, "C:\Mes_Sauvegardes\"
)
End
Sub
Sub
SauvegarderCeFichier
(
)
RépertoireDest =
PropriétéLire
(
"CheminSauvegarde"
)
If
RépertoireDest <>
""
Then
ThisWorkbook.SaveAs
RépertoireDest &
ThisWorkbook.Name
End
Sub
Vous retrouverez ces propriétés personnalisées via le menu « Fichier / Informations / Propriétés / Propriétés avancées / Personnalisation » :
L'utilisateur peut modifier la valeur d'une propriété personnelle par ce menu, ce qui peut être un avantage ou un inconvénient, suivant le but recherché.
La seconde méthode utilise les clés de la base de registre (par sécurité nous ne travaillerons que sur la clé « ConfigPerso » de l'utilisateur actif), ainsi le paramètre enregistré sera disponible pour tous les classeurs et aussi pour les autres applications qu'EXCEL.
Et puisque cette configuration est personnelle à l'utilisateur actif, un classeur partagé peut donc avoir des configurations propres à chaque utilisateur, ce qui peut être pratique.
Pour manipuler les clés de la base de registre, nous utiliserons le script « WSCript.Shell » :
Dim
ObjShell As
Object
Set
ObjShell =
CreateObject
(
"WScript.Shell"
)
-
la propriété RegWrite pour créer une nouvelle clé, avec en arguments :
- l'adresse de la clé, par exemple « HKCU\ConfigPerso\CheminSauvegarde »,
- la valeur à donner, « C:\Mes_Sauvegardes\ »,
- le format de la valeur qui sera toujours "REG_SZ", soit une chaîne, dans nos traitements ;
- la propriété RegRead avec en argument l'adresse de la clé concernée pour retourner sa valeur ;
- la propriété RegDelete avec en argument l'adresse de la clé concernée pour la supprimer.
Ce qui donne les fonctions :
'---------------------------------------------------------------------------------------
Public
Function
RegistreEcrire
(
NomClé As
String
, ValClé As
Variant
) As
Boolean
'---------------------------------------------------------------------------------------
' Ecrit NomClé avec la valeur ValClé au format String dans le registre "HKCU\ConfigPerso\"
'---------------------------------------------------------------------------------------
Dim
ObjShell As
Object
On
Error
GoTo
Gest_Err
' Supprime la clé si elle existe déjà:
Call
RegistreSupprimer
(
NomClé)
' Crée la clé et retourne True si tout se passe bien:
Set
ObjShell =
CreateObject
(
"WScript.Shell"
)
ObjShell.RegWrite
"HKCU\ConfigPerso\"
&
NomClé, ValClé, "REG_SZ"
Set
ObjShell =
Nothing
RegistreEcrire =
True
' Efface les erreurs:
Gest_Err
:
Err
.Clear
End
Function
'---------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------
Public
Function
RegistreLire
(
NomClé As
String
) As
Variant
'---------------------------------------------------------------------------------------
' Lit la clé "HKCU\ConfigPerso\" & NomClé et retourne sa valeur.
'---------------------------------------------------------------------------------------
Dim
ObjShell As
Object
On
Error
GoTo
Gest_Err
' Lit la clé:
Set
ObjShell =
CreateObject
(
"WScript.Shell"
)
RegistreLire =
ObjShell.RegRead
(
"HKCU\ConfigPerso\"
&
NomClé)
Set
ObjShell =
Nothing
' Efface les erreurs:
Gest_Err
:
Err
.Clear
End
Function
'---------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------
Public
Function
RegistreSupprimer
(
NomClé As
String
) As
Boolean
'---------------------------------------------------------------------------------------
' Supprime la clé "HKCU\ConfigPerso\" & NomClé.
'---------------------------------------------------------------------------------------
Dim
ObjShell As
Object
On
Error
GoTo
Gest_Err
Set
ObjShell =
CreateObject
(
"WScript.Shell"
)
ObjShell.RegDelete
"HKCU\ConfigPerso\"
&
NomClé
Set
ObjShell =
Nothing
RegistreSupprimer =
True
' Efface les erreurs:
Gest_Err
:
Err
.Clear
End
Function
'---------------------------------------------------------------------------------------
Pour initialiser la clé « CheminSauvegarde » puis l'utiliser lors d'une sauvegarde du fichier actif :
Sub
Initialisation
(
)
Call
RegistreEcrire
(
"CheminSauvegarde"
, "C:\Mes_Sauvegardes\"
)
End
Sub
Sub
SauvegarderCeFichier
(
)
RépertoireDest =
RegistreLire
(
"CheminSauvegarde"
)
If
RépertoireDest <>
""
Then
ThisWorkbook.SaveAs
RépertoireDest &
ThisWorkbook.Name
End
Sub
Vous retrouverez les clés créées en utilisant « Regedit.exe » depuis la barre de commande du menu « Démarrer » de Windows, ou depuis l'explorateur Windows :
L'utilisateur peut modifier la valeur d'une clé personnelle par cet éditeur, ce qui peut être un avantage ou un inconvénient, suivant le but recherché.
Certains seront tentés de dissimuler leurs informations parmi la multitude des clés existantes pour éviter qu'un utilisateur ne les découvre et les modifie, ce que l'on nomme de la stéganographie.
Pour obtenir la liste des clés d'un « répertoire » (les clés sont archivées à la manière des fichiers dans les répertoires, avec des sous-clés), vous devez utiliser les API comme dans le code ci-dessous inspiré du site : https://allapi.mentalis.org/apilist/253F9FB262EAA45DC6210E4066F9DFC3.html.
Private
Declare
Function
RegOpenKey Lib
"advapi32.dll"
Alias "RegOpenKeyA"
_
ByVal
hKey As
Long
, ByVal
lpSubKey As
String
, phkResult As
Long
) As
Long
Private
Declare
Function
RegEnumValue Lib
"advapi32.dll"
Alias "RegEnumValueA"
_
(
ByVal
hKey As
Long
, ByVal
dwIndex As
Long
, ByVal
lpValueName As
String
, _
lpcbValueName As
Long
, ByVal
lpReserved As
Long
, lpType As
Long
, lpData As
Any, _
lpcbData As
Long
) As
Long
Private
Declare
Function
RegCloseKey Lib
"advapi32.dll"
(
ByVal
hKey As
Long
) As
Long
'---------------------------------------------------------------------------------------
Public
Function
RegistreLister
(
ByVal
Répertoire As
String
, ByRef
NomClé As
Variant
, _
ByRef
ValClé As
Variant
) As
Boolean
'---------------------------------------------------------------------------------------
' Retourne la liste des sous-clés à l'adresse "HKCU\ConfigPerso\" & Répertoire.
' dans les variables à déclarer ainsi : Dim NomClé() As Variant, ValClé() As Variant.
'---------------------------------------------------------------------------------------
Dim
hKey As
Long
, Cnt As
Long
, sName As
String
, sData As
String
, Ret As
Long
, RetData As
Long
On
Error
GoTo
Gest_Err
' Ouvre le registre:
If
RegOpenKey
(&
H80000001, "ConfigPerso\"
&
Répertoire, hKey) =
0
Then
' Initialise les variables pour l'API:
sName =
Space
(
255
)
sData =
Space
(
255
)
Ret =
255
RetData =
255
' Récupère les informations:
While
RegEnumValue
(
hKey, Cnt, sName, Ret, 0
, ByVal
0
&
, ByVal
sData, RetData) <>
259
If
RetData >
0
Then
' Mémorise les informations.
ReDim
Preserve
NomClé
(
Cnt)
ReDim
Preserve
ValClé
(
Cnt)
NomClé
(
Cnt) =
Left
$(
sName, Ret)
ValClé
(
Cnt) =
Left
$(
sData, RetData -
1
)
' Prépare les mémoires pour le prochain appel à l'API:
Cnt =
Cnt +
1
sName =
Space
(
255
)
sData =
Space
(
255
)
Ret =
255
RetData =
255
End
If
Wend
' Ferme la clé du registre et Retourne VRAI:
RegCloseKey hKey
RegistreLister =
True
End
If
' Efface les erreurs:
Gest_Err
:
Err
.Clear
End
Function
'---------------------------------------------------------------------------------------
Voici un exemple qui utilise les clés personnelles de la base des registres pour alimenter une configuration de jours à exclure dans de la fonction ControleDate.
Par convention, les jours concernés ont été préalablement enregistrés dans la base de registre avec un nom de clé « JoursExclusFrance_n » où n est un libellé libre, cela n'a pas d'importance dans notre traitement, le tout placé dans le sous-répertoire « Dates_Interventions » la clé « ConfigPerso » de l'utilisateur actif.
Dans la fonction ControleDate, l'argument « JoursExclus » fait référence aux clés de ce sous-répertoire en utilisant par convention le signe « @ » :
Bob a modifié la fonction pour tester le cas où l'argument « JoursExclus » contient ce signe distinctif, afin d'en récupérer le sous-répertoire concerné (qui peut rester à vide si les clés sont dans le répertoire par défaut « HKCU\ConfigPerso ») et la valeur des clés dont le nom commence par celui passé en argument suivi du caractère underscore.
Case
"String"
LibJoursExclus =
UCase
(
JoursExclus)
Devient :
Case
"String"
If
InStr
(
1
, JoursExclus, "@"
) >
0
Then
' S'il faut lire la base des registres.
JoursExclus =
Split
(
JoursExclus, "@"
) ' Récupère le répertoire et le nom des clés.
JoursExclus =
RegistreAlimenterDepuisClés
(
JoursExclus
(
1
), JoursExclus
(
0
))
End
If
LibJoursExclus =
UCase
(
JoursExclus)
La fonction RegistreAlimenterDepuisClés lit les clés concernées et retourne une chaîne de caractères qui contient leur valeur.
'---------------------------------------------------------------------------------------
Public
Function
RegistreAlimenterDepuisClés
(
NomDesClés As
Variant
, _
Optional
Répertoire As
Variant
=
""
) As
String
'---------------------------------------------------------------------------------------
' Retourne une chaîne contenant la liste (séparée par une virgule) des valeurs des clés
' commencant par "NomDesClés_" à l'adresse "HKCU\ConfigPerso\" & Répertoire.
'---------------------------------------------------------------------------------------
' NomDesClés : nom des clés qui doivent avoir comme nom "NomDesClés" suivi de underscore.
' Répertoire : sous-répertoire de "HKCU\ConfigPerso\" où sont enregistrées les clés.
'---------------------------------------------------------------------------------------
Dim
i As
Long
, NomClé
(
) As
Variant
, ValClé
(
) As
Variant
On
Error
GoTo
Gest_Err
' Lecture de la liste des sous-clés du registre HKCU\ConfigPerso:
If
RegistreLister
(
Répertoire, NomClé, ValClé) =
True
Then
' Boucle sur les clés:
For
i =
LBound
(
NomClé) To
UBound
(
NomClé)
' Si le nom de la clé commence par NomDesClés alors récupérer sa valeur:
If
Left
(
NomClé
(
i), Len
(
NomDesClés)) =
NomDesClés Then
RegistreAlimenterDepuisClés =
RegistreAlimenterDepuisClés &
","
&
ValClé
(
i)
End
If
Next
i
' Supprime la première virgule au début de la chaîne:
RegistreAlimenterDepuisClés =
Replace
(
RegistreAlimenterDepuisClés, ","
, ""
, 1
, 1
)
End
If
' Fin du traitement:
Gest_Err
:
Err
.Clear
End
Function
'---------------------------------------------------------------------------------------
Ainsi, Alice est totalement autonome et peut créer autant de configurations qu'elle le souhaite à mesure de ses besoins, sans que Bob ait à intervenir dans le code VBA.
Par exemple, elle peut créer une configuration « JoursExclusBelgique » en générant les clés du registre correspondantes, « JoursExclusBelgique_n ».
Et quand elle modifie les clés du registre, cela se répercute sur tous les classeurs qui les utilisent.
Une formule conditionnelle en "E1" permet à Alice de choisir les jours à exclure de la saisie d'une date suivant le pays concerné :
=SI(D1="FRA";ControleDate(B1;"Dates_Interventions@JoursExclusFrance");SI(D1="BEL";ControleDate(B1;"Dates_Interventions@JoursExclusBelgique");"Dates non gérées pour ce pays"))
IX. Épilogue▲
Dehors le vent est tombé, la nature s'est endormie, et Bob rêve qu'il programme. Alors je chuchote pour ne pas les déranger…
Vous venez de lire un mémento écrit dans un style atypique. Certains trouveront l'exercice ridicule, mais j'assume la volonté de vouloir bousculer nos habitudes. En programmation aussi nos habitudes doivent changer…
Nos habitudes doivent changer car aujourd'hui les utilisateurs gorgent EXCEL de tableaux de plusieurs centaines de milliers de lignes, alors nos fonctions doivent désormais être capables de traiter le plus rapidement possible des données volumineuses.
Cela demande parfois plus d'efforts, plus d'imagination, voire de remplacer certaines fonctions intégrées qui s'étranglent sur de tels volumes, car conçues pour gérer 65 536 lignes les voilà confrontées à plus d'un million de lignes. En résumé, il est devenu utopique de se contenter de tester nos traitements sur un petit échantillon en se disant « c'est bon, ça marche », car il faut garder à l'esprit que depuis EXCEL 2007 la volumétrie n'est plus la même.
« EXCEL n'est pas fait pour cela, utilisez ACCESS pour gérer vos métadonnées » pesteront ceux qui militent pour que les outils soient employés à bon escient.
Certes, mais quand on n'a pas le choix, il faut bien faire avec. Alors autant bien le faire.
C'est pourquoi j'utilise si souvent QuickRanking, une fonction qui peut convenir à de nombreuses situations et qui travaille très rapidement.
Nos habitudes doivent changer car aujourd'hui les utilisateurs n'utilisent plus EXCEL comme un vulgaire tableur qui fait des additions, mais y voient un couteau suisse capable de tout gérer, et surtout, facile à manipuler, et attendent des services aboutis qui leur simplifient la vie.
Comme la saisie d'une date qui tient compte des jours fériés.
Comme la cohérence d'une saisie par rapport à un format attendu.
Comme le tri dynamique des données.
Ce ne sont là que quelques exemples, mais l'imagination sans fin des utilisateurs nous poussera à développer d'autres fonctions de calcul faciles d'emploi pour leur offrir une plus grande autonomie, alors même que la programmation en VBA, qui serait portant une solution appropriée, les rebute.
Nos habitudes doivent changer… en attendant une prochaine version d'EXCEL qui offrira enfin des fonctions intégrées adaptées aux capacités du bébé.
X. Les fichiers joints▲
-
VBA_EXCEL_EXEMPLES.xlsm (ou VBA_EXCEL.xlsm le même fichier mais sans les feuilles d'exemples) : le fichier pour EXCEL 2010 (version 32 bits, compatible 2016) qui reprend dans différents modules les codes sources des principales fonctions étudiées dans les six mémentos de cette série, avec des exemples, ainsi que quelques surprises pour les plus curieux, comme la fonction "ArbreDeSelection" pour afficher un arbre de sélection des données, déclinée aussi en fonction de calcul "ControleArbreDeSelection" afin de contrôler une saisie et afficher un arbre de sélection si la saisie n'est pas conforme.
Vous trouverez dans ce fichier les modules et les formulaires suivants :- VBO : contient les différentes fonctions étudiées au tome 1, et d'autres ;
- Img : contient les fonctions du tome 2 pour la programmation en mode graphique ;
- Img_Déclarations : contient les déclarations des API et des énumérations utilisées pour la programmation en mode graphique ;
- Main_PVDC : contient la fonction PVDC vue au tome 3 qui apporte une solution approchée au problème du voyageur de commerce. Utilise éventuellement le formulaire « UserForm_PVDC » pour afficher le chemin calculé. Un exemple d'utilisation est disponible sur la feuille « PVDC_Spirale » ;
- Crypto_Systeme : reprend les fonctions du tome 4 pour chiffrer ou déchiffrer les cellules d'un classeur, ou un fichier. Contient aussi les fonctions pour le test Miller Rabin pour déterminer si un nom est premier ou pas ;
- NP_Crible : contient les fonctions pour créer des fichiers de nombres premiers suivant une méthode inspirée du crible d'Ératosthène ;
- Crypto_CodeProjet (nécessite d'activer la référence Microsoft Visual Basic for Application Extensibility 5.3) : pour crypter les modules d'un classeur ;
- SQL (nécessite d'installer les références Microsoft DAO 3.6 Object Library et Microsoft ActiveX Data Objects 6.0 Library) : contient les fonctions du tome 5 pour faire des requêtes SQL sur les tableaux ;
- VBF : regroupe les fonctions de calcul du tome 6, ainsi qu'une fonction qui ouvre un arbre de sélection des données suite à une saisie. Un exemple d'utilisation est disponible sur la feuille « Choix_Ville » ;
- VBTreeView (nécessite d'installer la bibliothèque Microsoft Windows Common Controls 6) : contient les fonctions pour générer facilement un arbre de sélection des données. Utilise le formulaire "UserForm_TreeView" qui contient un objet TreeView et un objet ListView. Voir les documentations Apprendre le TreeView en Visual Basic de Jacques Malatier et Utiliser le contrôle ListView en VBA Excel de SilkyRoad ;
- ModMsgBoxPlus : un module de Thierry Gasperment qui contient la fonction "MsgBoxEx" (plus complète que "MsgBoxTimer" du tome 1) pour ouvrir une fenêtre de message qui lit le format RTF (texte formaté, liens hypertextes). La fonction "MsgBoxRTF" permet d'en simplifier l'usage.
- QuickRanking Vs QuickSort.xlsm : un fichier pour comparer la vitesse d'exécution des algorithmes QuickRanking et QuickSort sur le tri de vos données, ainsi que QuickSort_AndRank (dérivé de QuickSort) lorsque le classement est nécessaire. Vous comprendrez mieux pourquoi j'utilise QuickRanking dans mes traitements et vous serez surpris de sa rapidité d'exécution.
XI. Conclusion▲
Il arrive parfois dans une cour de récréation que des grands en CM2 s'attachent à un petit du CP et lui permettent de jouer avec eux : quel honneur !
Alors je ne peux pas conclure ces quatre années de travail sans avoir une pensée émue pour ceux qui ont participé à mes mémentos en corrigeant patiemment mes erreurs et en m'apportant de nombreux conseils ; pour tous ces volontaires passionnés qui travaillent dans l'ombre et sans qui vous ne liriez pas ces lignes ; pour tous ceux qui partagent leur savoir, gratuitement, sans prétention et sans rien attendre en contrepartie, juste pour le plaisir de partager.
Si vous vous reconnaissez dans ces valeurs, n'hésitez plus : venez prendre la relève, avec des idées nouvelles, des connaissances que je n'ai pas, rejoignez cette équipe qui vous fera grandir.
Je vois d'ici des yeux qui brillent… me trompé-je ?
Le lien pour contacter la rédaction : https://club.developpez.com/contacts/contribuer/
Laurent OTT. 2018
XII. Remerciements▲
Je veux rendre hommage à ces personnes qui ont consacré énormément de leur temps pour permettre la publication de ces six mémentos, et sont intervenues à différentes étapes : relecture technique, correction orthographique, correction typographique, mise au gabarit, publication.
Par ordre alphabétique :
Arkham46 (Responsable Access), Chrtophe (Responsable Système), Claude Leloup (Rédacteur Modérateur), Djibril (Responsable Pertl et Outils) Dourouc05 (Responsable Qt), f-leb (Rédacteur Modérateur), Gaby277 (Membre éprouvé), Lolo78 (Rédacteur Modérateur), Pierre Fauconnier (Responsable Office et Excel), Siguillaume (Community Manager), Winjerome (Expert éminent senior).
Merci aussi à vous, lectrices et lecteurs, toujours plus nombreuses et nombreux, qui faites l'effort de lire mes mémentos et me donnent une raison supplémentaire de les rédiger.
Et pour finir, merci à Claude Leloup qui par son compliment, « Quelle belle plume », m'a donné des ailes…