IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)

Apprendre la programmation en VBA pour EXCEL par la pratique - Sixième partie

Tome 6 : Apprendre la programmation de nouvelles fonctions Excel pour l’utilisateur

Ce dernier mémento conclut la série de cours pour apprendre VBA de Excel. Dans cette sixième et dernière partie, vous allez apprendre à écrire de nouvelles fonctions pour l’utilisateur.

Un espace de partage vous est proposé sur le forum pour recevoir vos avis. 52 commentaires Donner une note à l´article (5)

Article lu   fois.

L'auteur

Profil Pro

Liens sociaux

Viadeo Twitter Facebook Share on Google+   

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 :

 
Sélectionnez
'---------------------------------------------------------------------------------------
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 :

Image non disponible
  • 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.

 
Sélectionnez
'---------------------------------------------------------------------------------------
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.

 
Sélectionnez
'---------------------------------------------------------------------------------------
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 :

Image non disponible

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 » :

Image non disponible

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

Image non disponible

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 » :

Image non disponible

En à peine 30 secondes, j'obtiens ma liste, et je renomme la cellule "F1" en « Téléphone sans doublon ».

Image non disponible

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" :

Image non disponible

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 :

Image non disponible

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 :

Image non disponible

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.
Image non disponible

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é.
 
Sélectionnez
'---------------------------------------------------------------------------------------
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.
 
Sélectionnez
'---------------------------------------------------------------------------------------
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.

Image non disponible

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 :

Image non disponible

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 :

Image non disponible

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 :

 
Sélectionnez
'---------------------------------------------------------------------------------------
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 :

 
Sélectionnez
'---------------------------------------------------------------------------------------
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.

Image non disponible

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 :

Image non disponible

Ou bien =ControleDate(B1; F1:F14; VRAI) :

Image non disponible

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" :

Image non disponible
 
Sélectionnez
'---------------------------------------------------------------------------------------
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.

 
Sélectionnez
'---------------------------------------------------------------------------------------
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 » :

Image non disponible
 
Sélectionnez
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 :

 
Sélectionnez
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.
 
Sélectionnez
ActiveWorkbook.CustomDocumentProperties.Item(NomPropriété).Value

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 :

 
Sélectionnez
ActiveWorkbook.CustomDocumentProperties.Item(NomPropriété).Delete

NomPropriété est le nom de la propriété concernée, ici « CheminSauvegarde ».

Ce qui donne les fonctions suivantes :

 
Sélectionnez
'---------------------------------------------------------------------------------------
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 :

 
Sélectionnez
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 » :

Image non disponible

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 » :

 
Sélectionnez
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 :

 
Sélectionnez
'---------------------------------------------------------------------------------------
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 :

 
Sélectionnez
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 :

Image non disponible

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.

 
Sélectionnez
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.

Image non disponible

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 « @ » :

Image non disponible

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.

 
Sélectionnez
Case "String"
       LibJoursExclus = UCase(JoursExclus)

Devient :

 
Sélectionnez
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.

 
Sélectionnez
'---------------------------------------------------------------------------------------
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"))

Image non disponible

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…

Vous avez aimé ce tutoriel ? Alors partagez-le en cliquant sur les boutons suivants : Viadeo Twitter Facebook Share on Google+   

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2018 Laurent OTT. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts. Droits de diffusion permanents accordés à Developpez LLC.