Fonctions prêtes à l'emploi

Toutes les fonctions ici présentes sont agrémentées de divers commentaires pour mieux les appréhender. Plus vous descendez dans cette page, et plus les commentaires se raréfient, parce que je pars du point de vue que vous êtes de plus en plus à l'aise. D'autre part, toutes les fonctions présentées ici sont vraiment utiles, et je vous recommande de les copier dans votre PERSO.XLS, histoire de les avoir toujours sous la main. Pour plus d'informations sur PERSO.XLS, consultez la page correspondante.

Attention : Vous allez constater que pour appeler une macro stockée dans PERSO.XLS depuis un autre classeur, il est nécessaire de faire précéder l'appel par Perso.XLS!. Il faut le savoir...

Calcul d'un tarif horaire

Il n'existe pas à ma connaissance de fonction Excel qui permet de calculer le montant dû pour une période donnée. Par exemple, si je travaille à 180.--/H et que je travaille pendant 6:00, le résultat va être bien étrange : Essayez vous même : Dans la cellule A1, écrivez 6:00 , dans la cellule A2, écrivez 180, et dans la cellule A3, écrivez =A1*A2. Vous n'aurez pas du tout 1'080.00 comme on pourrait s'y attendre. Bien entendu, on pourrait écrire 6 à la place de 6:00, et ça marcherait, mais alors, comment écrire 6:45 ? Si on écrit 6.45, le calcul sera faux. Il faudrait écrite 6.75 * 180 pour que ce soit juste. La galère !

En fiut c'est la galère parce qu'Excel convertit les heures et les minutes en centièmes de journée. 6:00 est représenté par Excel comme étant 6/24èmes de la journée, c'est à dire le quart, soit 0.25. Donc 6:00 = 0.25.

La fonction que je vous propose de copier dans votre PERSO.XLS afin de l'avoir toujours sous la main est la suivante :

Function CalculMontantSelonBaremeHoraire(Heure, TarifHoraire) As Single
  CalculMontantSelonBaremeHoraire = Heure * 60 * 24 * (TarifHoraire / 60)
End Function

Cette fonction peut directement s'appeler dans une feuille de calcul, tout simplement comme ceci (d'ailleurs, si vous l'avez bien recopiée dans Perso.XLS, vous verrez apparaître CalculMontantSelonBaremeHoraire dans la liste des fonctions disponibles)

Si vous écrivez la même chose que le tableau ci dessus dans votre feuille Excel, A3 contiendra 960.

Ceci dit, il est également possible, et c'est aussi là toute la force des fonctions personnalisées, d'appeler cette fonction depuis une autre Macro Excel, comme ceci :

Sub NimporteQuoi()
  X = CalculMontantSelonBaremeHoraire(#2:00:00 AM#, 150)
  MsgBox X ' Affichera 300
  ' Mais on peut également appeler cette fonction comme ceci :
  MsgBox CalculMontantSelonBaremeHoraire(#2:00:00 AM#, 150)
  ' Qui affichera 300 également
  ' Le premier paramètre Heure doit être de type Date/Heure
  ' MsgBox CalculMontantSelonBaremeHoraire("2:00", 150)
  ' Ne fonctionne pas
  ' Mais par contre, si on convertit la chaîne de caractère en Date/Heure, tout va à nouveau bien :
  MsgBox CalculMontantSelonBaremeHoraire(CDate("2:00"), 150)
  ' (Pour plus d'infos sur CDate, cliquez sur CDate, et appuyez sur F1)
End Sub

Quelle est la marge entre le prix d'achat et le prix de vente

Si on connait le prix d'achat (Par exemple 90 francs), et le prix de vente (Par exemple 110 francs). On peut calculer aisém,ent la marge (110-90 = 20 francs). Mais quel est le pourcentage de marge que l'on fait ? Pour le savoir, il faut faire la formule mathématique suivante : (Prix de vente / Prix d'achat) -1. Dans notre exemple : (110/90 = 1.22222, et 1.2222-1 = 0.2222 qui, en format pourcentage donne 22.2222 % de marge. Dans ce cas précis, on pourrait se demander sérieusement si la construction d'une fonction personnalisée est bien utile. En effet, il suffit de faire la formule suivante :

Dans C2, vous obtiendrez dans ce cas 0.22222. Il vous suffit de sélectionner C2 et de le mettre en format % (en cliquant sur le signe %). Maintenant, pour l'exercice, je vous propose de créer une fonction qui va remplacer cette formule, comme ceci :

ATTENTION : Cette fois, il y a 2 paramètres : La fonction devra commencer par CalculMarge(PrixAchat, PrixVente) (Constatez que c'est une virgule et pas un point-virgule qui sépare les paramètres)

Voici la solution, comme pout l'exercice précédent, en blanc sur fond blanc :

Function CalculMarge(PrixAchat, PrixVente)
  CalculMarge = (PrixAchat / PrixVente) - 1
End Function

Un nombre est-il premier ou pas ?

Un nombre premier est un nombre qui ne se divise par aucun autre nombre, a part bien sûr que par 1 et par lui même. Par exemple, 23 est un nombre premier car il n'est divisible que par 1 et par 23. Bon, il y a des trucs simples, comme par exemple, il n'y a aucun nombre pair premier... Ben oui, puisqu'il est pair, il est forcément divisible par 2. Mais 4397, il est premier ou pas ?

Ce serait vraiment sympathique d'avoir une fonction qui s'appellerait EstPremier et qui renverrait VRAI si le nombre est premier, sinon Faux, comme ceci :

Qui donnerait réellement sur vore feuille de calcul

Et bien, cette fonction n'est pas aussi facile à écrire que la précédente. En effet, et heureusement pour les programmeurs, cette fonction requiert une certaine dextérité et de savoir manier les boucles For To Next de manière optimisée. Aussi, je vous renverrai vers le chapitre Apprenez la programmation avec Word, ou à un ouvrage de base sur l'algorithmie pour plus de compréhension.

Toujours est-il que si vous copiez cette fonction dans votre environnement VBA Excel et que vous l'utilisez comme si vous saviez très exactement ce qu'elle fait, vous constaterez qu'elle renvoie effectivement VRAI quand le nombre passé en paramètre est premier, sinon, FAUX. Voici cette fonction :

Function EstPremier(QuelNombre) As Boolean
  If QuelNombre = 1 Then
    EstPremier = True
    Exit Function
  End If

  If QuelNombre Mod 2 = 0 Then
    EstPremier = False
    Exit Function
  End If

  For Ctr = 3 To QuelNombre / 2 Step 2
    If QuelNombre Mod Ctr = 0 Then
      EstPremier = False
      Exit Function
    End If
  Next

  EstPremier = True
End Function

On pourrait imaginer que cette fonction est un peu une "Boîte noire" dont on ne sait pas grand chose, mais qui nous donne le résultat qu'on attend. Et après tout, c'est tout ce qu'on lui demande !

Partant de ce principe, si on ne voulait pas qu'il écrive VRAI ou FAUX, mais plutôt le mot Premier si le nombre est premier, sinon rien, comme ceci :

Et bien, nul besoin de changer quoi que ce soit dans la fonction... Ajoutons simplement une fonction SI autour de la fonction EstPremier, comme ceci :

Bon évidemment ça implique de savoir utiliser la fonction SI...

Arrondir un montant à 5 centimes

Dans le chapitre des macros complémentaires, vous avez eu le loisir d'étudier l'ajout de la fonction préexistante ARRONDI.AU.MULTIPLE. Si vous êtes curieurx de voir comment cette fonction est écrite, voici la même fonction (je ne sais pas si elle est vraiment identique à ARRONDI.AU.MULTIPLE, mais en tout cas elle retourne les mêmes résultats)

Function ArrondiPersonnalise(QuelNombre, QuellePrecision)
  ArrondiPersonnalise = CLng(QuelNombre * (1 / QuellePrecision)) / (1 / QuellePrecision)
End Function

Exercices

Conversion Centigrade/Farenheit

Vous allez vous livrer à un petit exercice de création de fonction personnalisée. Il s'agit de créer une fonction qui transforme les degrés centigrades en degrés Farenheit. La formule mathématique est : C° = (5/9) X (F°-32). Par exemple, 100° Farenheit = (5/9) X (100-32)° Centigrades. 5 divisé par 9 = 0.55555. 100-32 = 68. 0.5555 X 68 = 37.774 (degrés Farenheit)

Il faudrait que l'on puisse appeler la formule comme ceci :

La solution se trouve juste ici en dessous, mais elle est écrite en blanc sur fond blanc, ce qui fait que si vous voulez la voir, vous devez sélectionner les 3 lignes ici en dessous, faire Edition/Copier, et les coller dans votre VBA Excel, par exemple juste en dessous de la fonction que vous avez créé vous même, pour voir si vous avez bien compris :

Function Farenheit(DegreCentigrade)
  Farenheit = (5 / 9) * (100 - DegreCentigrade)
End Function

Fin des exercices

Calculer des heures supérieures à 24 heures sans passer au jour suivant

L'idée est ici de faciliter particulièrement la tâche aux concepteurs de bases de données qui désirent cumuler des heures et des minutes (de travail par exemple), et d'obtenir un total d'heures de travail supérieur à 24 en gardant le format de Date/Heure standard Cette fonction permet de calculer la somme de 2 ou plusieurs dates dont le total est éventuellement supérieur à 24 heures sans afficher un format du style "02:30" au lieu de "26:30" Cette fonction prend en charge 2 paramètres : Interval, qui n'est autre que la somme de 2 ou plusieurs heures. Par exemple, imaginons un formulaire qui contient 2 champs Temps1 et Temps2. Interval pourrait très bien être : Temps1 + Temps2. Le 2ème paramètre est Fmt (Format), qui est une chaîne de caractère devant faire partie de la liste énumérée ici-bas ("J H" , "H:MM", etc.)

EXEMPLE  :

Admettons que le Champs Temps1 contienne 23:59, et le champs Temps2 contienne 01:00

MsgBox  FormatInterval (Temps1 + Temps2 , "H:MM")

Affichera 24:59 (et non pas 00:59)

J'ai constaté que certaines des constantes de Fmt ne fonctionnaient pas complètement bien. Par contre les deux formats

H:MM (24:59 par exemple) et
H:MM:SS (24:59:00 par exemple)

eux, fonctionnent parfaitement, et ça tombe bien, ce sont les 2 formats les plus intéressants.

' Cette fonction permet de renvoyer des formats de dates en heures, minutes et secondes supérieures à 24 heures
' Formats supportés (Dans le paramètre Fmt)
' J H 5 jours 5 heures
' J H:MM 5 jours 5:15
' J HH:MM 5 jours 05:15
' J H:MM:SS 5 jours 5:15:45
' J HH:MM:SS 5 jours 05:15:45
' H M 125 heures 15 Minutes
' H:MM 125:15
' H:MM:SS 125:15:45
' M S 7515 Minutes 45 Secondes

Function FormatInterval(ByVal Interval As Variant, Fmt As String)
     Dim Days As Long, Hours As Long, Minutes As Long, Seconds As Long

     ' S'agit-il d'une date ou d'un nombre à virgule ?
     If VarType(Interval) <> 7 And VarType(Interval) <> 5 Then Exit Function

     Days = Int(Interval)
     Interval = Interval - Days
     If Interval > #11:59:59 PM# Then
     Days = Days + 1
     Interval = 0#
     End If

     Interval = Interval * 24
     Hours = Int(Interval)
     Interval = Interval - Hours
     If Interval > 3599# / 3600# Then
        Hours = Hours + 1
        Interval = 0#
     End If

     Interval = Interval * 60
     Minutes = Int(Interval)
     Interval = Interval - Minutes
     If Interval > 59# / 60# Then
        Minutes = Minutes + 1
        Interval = 0#
     End If

     Seconds = Int(Interval * 60 + 0.5)

     If Seconds = 60 Then
        Minutes = Minutes + 1
        Seconds = 0
     End If

     If Minutes > 59 Then
        Hours = Hours + 1
        Minutes = Minutes - 60
     End If

     If Hours > 23 Then
        Days = Days + 1
        Hours = Hours - 24
     End If

     Select Case Fmt
          Case "J H"
               FormatInterval = Days & IIf(Days <> 1, " Jours ", " Jour ") & Hours & IIf(Hours <> 1, " Heures", " Heure")
          Case "J H:MM"
               FormatInterval = Days & IIf(Days <> 1, " Jours ", " Jour ") & Hours & ":" & Format(Minutes, "00")
          Case "J HH:MM"
               FormatInterval = Days & IIf(Days <> 1, " Jours ", " Jour ") & Hours &  Format(Hours, "00") & ":" & Format(Minutes, "00")
          Case "J H:MM:SS"
               FormatInterval = Days & IIf(Days <> 1, " Jours ", " Jour ") & Hours & ":" & Format(Minutes, "00") & ":" & Format(Seconds, "00")
          Case "J HH:MM:SS"
               FormatInterval = Days & IIf(Days <> 1, " Jours ", " Jour ") & Format(Hours, "00") & ":" & Format(Minutes, "00") & ":" & Format(Seconds, 0)
          Case "H M"
               Hours = Hours + Days * 24
               FormatInterval = Days & IIf(Days <> 1, "Jours ", " Jour ") & Hours & Minutes & IIf(Minutes <> 1, "Minutes", " Minute")
          ' Le cas le plus intéressant, et qui marche :
          Case "H:MM"
               Hours = Hours + Days * 24
               FormatInterval = Hours & ":" & Format(Minutes, "00")
          ' Le 2ème cas le plus intéressant qui marche :
          Case "H:MM:SS"
               Hours = Hours + Days * 24
               FormatInterval = Hours & ":" & Format(Minutes, "00") & ":" & Format(Seconds, "00")
          Case "M S"
               Minutes = Minutes + (Hours + Days * 24) * 60
               FormatInterval = Minutes & IIf(Minutes <> 1, " Minutes ", " Minute ") & Seconds & IIf(Seconds <> 1, " Secondes", " Seconde")
          Case Else
               FormatInterval = "Format invalide"
     End Select
End Function

Extraction d'une sous-chaîne de caractère dans une chaîne

Cette fonction permet d'extraire une partie d'une chaîne de caractères quand celle ci a toujours la même structure. Prenons l'exemple suivant : Vous avez un fichier texte qui contient les lignes suivantes :

Marc Dupont, Ville : Paris, E-Mail : mdupont@truc.fr, Tél.: 43.99.88.09
Yvan Desclous, Ville : Grenoble, E-Mail : desclous@machin.fr, Tél.: 11.22.33.44
Paul Truc, Ville : Berlin, E-Mail : tpaul@chose.fr, Tél.: 44.66.55.88

Pour Extraire l'E-Mail de chacune de ces personnes, je vous souhaite bonne chance, surtout s'il y en a 2'500... La petite fonction que je vous propose d'implémenter va s'occuper de tout cela...

Dans notre exemple, nous voulons mettre l'E-Mail dans une variable VARemail :

LigneComplete = "Marc Dupont, Ville : Paris, E-Mail : mdupont@truc.fr, Tél.: 43.99.88.09"
VARemail =Extraction(LigneComplete  ,   "E_Mail : "  ,    ", Tél")

VARemail contiendra exactement la chaîne suivante : mdupont@truc.fr

On ne peut pas utiliser cette grande fonction directement dans Excel. Pour une raison que j'ignore, il faut appeler une autre petite fonction qui appelle la grande, comme ceci :
Function PrendreUnePartie(ChaineTexte, Depuis, Jusqua)
  PrendreUnePartie = Extraction(ChaineTexte, Depuis, Jusqua)
End Function
Dans Excel, =Extraction("abcdef";"a";"c") donne une erreur, mais =PrendreUnePartie("abcdef";"a";"c") est correct...

' UTILITE : Cette fonction permet de récupérer une chaîne de texte dans une chaîne de caractères, entre
' 2 balises.
' EXEMPLES :
' X = Extraction ("ABCDEFGHIJKL", "CD", "i") Renvoie "EFGH"
' X = Extraction ("ABCDEFGHIJKL", "#BEGIN#", "i") Renvoie "ABCDEFGH"
' X = Extraction ("ABCDEFGHIJKL", "#BEGIN#", "#END#") Renvoie "ABCDEFGHIJKL"
' X = Extraction ("ABCDEFGHIJKL", "J", "#END#") Renvoie "KL"
' X = Extraction ("ABCDEFGHIJKL", "J", "J") Renvoie "###INFO 3000 ERREUR : Fin avant de début, ou retour fonction vide ###"
' X = Extraction ("ABCDEFGHIJKL", "J", "K") Renvoie "###INFO 3000 ERREUR : Fin avant de début, ou retour fonction vide ###"
' X = Extraction ("BxxxA AyyyB", "a", "b") Renvoie "###INFO 3000 ERREUR : Fin avant de début, ou retour fonction vide ###"
' X = Extraction ("ABCDEFGHIJKL", "XXX", "J") Renvoie "###INFO 3000 ERREUR : Début inexistant###"
' X = Extraction ("ABCDEFGHIJKL", "XXX", "YYY") Renvoie "###INFO 3000 ERREUR : Début inexistant###"
' X = Extraction ("ABCDEFGHIJKL", "BC", "XXX") Renvoie "###INFO 3000 ERREUR : Fin inexistante ###"
' X = Extraction ("AbonjourZ AaurevoirZ", "a", "z") Renvoie "bonjour"

Function Extraction(ChaineTexte, Depuis, Jusqua)
   Dim Ctr As Integer ' Compteur polyvalent
   Dim Drapeau As Boolean ' Détermine si une erreur est survenue (les balises DEPUIS ou JUSQUA n'existent pas)
   Dim PositionDebut As Integer ' Contient la position de la fin de la chaine DEBUT + 1 caractere
   Dim PositionFin As Integer ' Contient la position du début de la chaine JUSQUA
   Dim LongueurDepuis As Integer ' Contient la longueur de la balise DEPUIS
   Dim LongueurJusqua As Integer ' Contient la longueur de la balise JUSQUA
   Dim LongueurChaineTexte As Integer ' Contient la longueur de la chaîne de caractère complète

   LongueurDepuis = Len(Depuis)
   LongueurJusqua = Len(Jusqua)
   LongueurChaineTexte = Len(ChaineTexte)

   ' Est-ce que l'utilisateur a entré un mot-clé pour commencer au début : #BEGIN#
   ' ou terminer à la fin : #END#
   If Depuis = "#BEGIN#" Then
      PositionDebut = 1
   End If
   If Jusqua = "#END#" Then
      PositionFin = LongueurChaineTexte
   End If

   If Depuis <> "#BEGIN#" Then
      ' Recherche de la délimitation DEBUT du début de la recherche
      Drapeau = False
      For Ctr = 1 To LongueurChaineTexte - LongueurDepuis
          If Mid$(ChaineTexte, Ctr, LongueurDepuis) = Depuis Then
             Drapeau = True
             PositionDebut = Ctr + LongueurDepuis
             Exit For
          End If
      Next
      ' Si la délimitation du début DEPUIS n'existe pas, générer une erreur
      If Drapeau = False Then
         Extraction = "###INFO 3000 ERREUR : Début inexistant###"
         Exit Function
      End If
   End If

   If Jusqua <> "#END#" Then
      ' Recherche de la délimitation FIN
      Drapeau = False
      For Ctr = 1 To LongueurChaineTexte - LongueurJusqua
          If Mid$(ChaineTexte, Ctr, LongueurJusqua) = Jusqua Then
             Drapeau = True
             PositionFin = Ctr - 1
             Exit For
          End If
      Next
     
      ' Si la délimitation de fin JUSQUA n'existe pas, générer une erreur
      If Drapeau = False Then
         Extraction = "###INFO 3000 ERREUR : Fin inexistante ###"
         Exit Function
      End If
   End If

   If PositionFin < PositionDebut Then
      Extraction = "###INFO 3000 ERREUR : Fin avant de début, ou retour fonction vide ###"
      Exit Function
   End If

   ' Retour correct de la fonction :
   Extraction = (Mid$(ChaineTexte, PositionDebut, PositionFin - (PositionDebut - 1)))

End Function