Je vous propose une petite fonction VBA pour convertir le nom d’un mois de l’année en son numéro. Les noms/abréviations sont composés au minimum de 2 lettres, écrits en français ou en anglais.
Le nom des mois
L’abréviation à une lettre (J F M A M J J A S O N D), prise individuellement, ne permet pas de distinguer certains mois comme ‘Janvier’ et ‘Juin’ (non implémentée ici).
Les abréviations à deux lettres permettent cette distinction, soit en utilisant la première et la dernière lettre du mois (JR FR MS AL MI JN JT AT…) pour le codage à 2 caractères, soit en utilisant la première lettre du nom et une autre lettre du nom anglais (JA FE MR AL MA JN JL AU…) pour le codage bilingue.
L’abréviation à trois caractères correspond aux 3 premiers caractères du nom (sauf pour Juin et Juillet) et les accents sont conservés (JAN FÉV MAR AVR MAI JUN JUL AOÛ…)
Les abréviations de longueur variable correspondent aux premiers caractères du nom suivi d’un point dans le cas d’une troncation (Janv. Févr. Mars Avr. Mai Juin Juill. Août…).
Voir ici pour en savoir plus sur les mois.
La fonction en VBA
'Retourne le numéro mois (abréviation ou non, français ou anglais) passé en paramètre
'Auteur : Philben - v1.0 - Free to use
'Exemples : NumMois("at")/NumMois("au")/NumMois("aou")/NumMois("aout")/NumMois("aug") -> n°8 (Août)
'références : http://fr.wikipedia.org/wiki/Mois
' : http://66.46.185.79/bdl/gabarit_bdl.asp?Th=3&id=3619
'Seuls É et Û sont présents dans le nom des mois, mais recherche élargie au cas où:
Const cAvecAccent As String = "ÀÁÂÄÇÈÉÊËÌÍÎÏÒÓÔÖÙÚÛÜ"
Const cSansAccent As String = "AAAACEEEEIIIIOOOOUUUU"
Const cCode3Car As String = "JAN FEV MAR AVR MAI JUN JUL AOU SEP OCT NOV DEC JAN FEB MAR APR MAY JUN JUL AUG"
Const cCode2Car As String = "JRFRMSALMIJNJTATSEOENEDEJAFEMRALMAJNJLAUSEOCNODE"
Const cEspace As String = " ", cJUI As String = "JUI"
Dim l As Long, i As Integer, p As Integer, f As String
Mois = UCase$(Left$(Trim$(Mois), 4))
'supprime les espaces intra-chaîne pour ne pas fausser les étapes suivantes
If InStr(1, Mois, cEspace, vbBinaryCompare) <> 0 Then Mois = Replace(Mois, cEspace, vbNullString, , , vbBinaryCompare)
l = Len(Mois)
If l > 1 Then
For i = 1 To l 'Supprime les accents - 4 boucles au maximum
f = Mid$(Mois, i, 1)
p = InStr(1, cAvecAccent, f, vbBinaryCompare)
If p > 0 Then Mois = Replace(Mois, f, Mid$(cSansAccent, p, 1), , , vbBinaryCompare)
Next i
If l > 2 Then
f = Left$(Mois, 3)
p = InStr(1, cCode3Car, f, vbBinaryCompare)
If p = 0 And l > 3 Then 'si non trouvé, recherche Juin/Juillet
If StrComp(f, cJUI, vbBinaryCompare) = 0 Then
p = InStr(1, cCode3Car, Left$(Mois, 2) & Mid$(Mois, 4, 1), vbBinaryCompare)
End If
End If
l = 4
Else 'si longueur de la chaîne est strictement égale à 2
p = InStr(1, cCode2Car, Mois, vbBinaryCompare)
End If
If (p And 1) = 1 Then 'une correspondance a été trouvée
NumMois = Int(p / l) + 1
If NumMois > 12 Then NumMois = (NumMois - 1) Mod 12 + 1
End If
End If
End Function
Explications
Les premières étapes consistent à formater le nom du mois pour réduire son espace de liberté et faciliter ainsi la transformation. On ne conserve que les 4 premiers caractères du nom qui doivent permettre une identification sans ambiguïté. Ces caractères sont tranformés en lettres capitales pour réaliser par la suite des recherches/remplacements/comparaisons binaires.
Cette première étape consiste aussi à supprimer les espaces et à retirer les accents en balayant large pour tenir compte des fautes de frappes…
Deuxième étape : Suivant la longueur du nom/abréviation du mois, on distingue ensuite deux cas pour ne pas interférer entre les abréviations à deux lettres et le reste.
Concernant les abréviations à 2 lettres, on recherche simplement sa présence dans une chaîne constante ‘cCode2Car’ qui les contient toutes. La fonction InStr() renvoie la position de l’abréviation dans la constante ou 0.
Pour les autres abréviations, le principe est le même en utilisant la constante ‘cCode3Car’. Pour distinguer le mois de Juin du mois de Juillet et seulement pour ces deux mois , il est parfois nécessaire d’analyser la 4ème lettre (‘N’ ou ‘L’).
Après cette étape, on a donc une position du nom (variable p) dans les chaînes constantes ou 0 si le nom n’est pas trouvé.
La troisième et dernière étape de la fonction consiste, premièrement, à vérifier que la position existe et qu’elle soit conforme. Conforme veut dire que la première lettre du mois correspond bien à la première lettre d’une abréviation pour éviter par exemple que le mois ‘RF’ qui est sans signification soit interprété comme le mois de janvier. En effet, la constante ‘cCode2Car’ contient le motif ‘RF’ (JRFRMS…)
Pour ce faire, chaque abréviation dans les constantes commence à une position impaire, il suffit alors de vérifier que la position trouvée est bien impaire en vérifiant que le reste de la division par 2 est égal à 1 If (p And 1) = 1 Then ....
Le numéro du mois correspondant est calculé en divisant la position par la longueur des motifs + 1.
Le numéro de mois calculé peut être supérieur à 12 car les chaînes de constante contiennent plus de 12 motifs chacune. On retourne dans ce cas le reste de la division par 12 pour obtenir le bon numéro If NumMois > 12 Then NumMois = (NumMois - 1) Mod 12 + 1.
Test de la fonction
La fonction suivante contrôle que les abréviations sont bien reconnues et qu’il n’existe pas d’interférence (‘RF’, ‘AN F’, …)
Const cCode3Car As String = "JAN FEV MAR AVR MAI JUN JUL AOU SEP OCT NOV DEC JAN FEB MAR APR MAY JUN JUL AUG"
Const cCode2Car As String = "JRFRMSALMIJNJTATSEOENEDEJAFEMRALMAJNJLAUSEOCNODE"
Dim i As Integer, j As Integer, k As Integer, l As Integer, n As Integer
Dim c As String, m As String
Debug.Print "Mois", "Théorique", "Calculé", "Conforme ?"
c = cCode2Car
For i = 2 To 4 Step 2
For j = 1 To 2
For k = j To Len(c) Step i
m = Mid$(c, k, i)
l = NumMois(m)
n = n + 1
If n > 12 Then n = 1
Debug.Print m, n, l, IIf(l = 0, "?", l = n)
Next k
Next j
n = 0
c = cCode3Car
Next i
End Function
Résultat attendu :
JR 1 1 Vrai
FR 2 2 Vrai
MS 3 3 Vrai
AL 4 4 Vrai
MI 5 5 Vrai
JN 6 6 Vrai
JT 7 7 Vrai
AT 8 8 Vrai
SE 9 9 Vrai
OE 10 10 Vrai
NE 11 11 Vrai
DE 12 12 Vrai
JA 1 1 Vrai
FE 2 2 Vrai
MR 3 3 Vrai
AL 4 4 Vrai
MA 5 5 Vrai
JN 6 6 Vrai
JL 7 7 Vrai
AU 8 8 Vrai
SE 9 9 Vrai
OC 10 10 Vrai
NO 11 11 Vrai
DE 12 12 Vrai
RF 1 0 ?
RM 2 0 ?
SA 3 0 ?
LM 4 0 ?
IJ 5 0 ?
NJ 6 0 ?
TA 7 0 ?
TS 8 0 ?
EO 9 0 ?
EN 10 0 ?
ED 11 0 ?
EJ 12 0 ?
AF 1 0 ?
EM 2 0 ?
RA 3 0 ?
LM 4 0 ?
AJ 5 0 ?
NJ 6 0 ?
LA 7 0 ?
US 8 0 ?
EO 9 0 ?
CN 10 0 ?
OD 11 0 ?
E 12 0 ?
JAN 1 1 Vrai
FEV 2 2 Vrai
MAR 3 3 Vrai
AVR 4 4 Vrai
MAI 5 5 Vrai
JUN 6 6 Vrai
JUL 7 7 Vrai
AOU 8 8 Vrai
SEP 9 9 Vrai
OCT 10 10 Vrai
NOV 11 11 Vrai
DEC 12 12 Vrai
JAN 1 1 Vrai
FEB 2 2 Vrai
MAR 3 3 Vrai
APR 4 4 Vrai
MAY 5 5 Vrai
JUN 6 6 Vrai
JUL 7 7 Vrai
AUG 8 8 Vrai
AN F 9 0 ?
EV M 10 0 ?
AR A 11 0 ?
VR M 12 0 ?
AI J 1 0 ?
UN J 2 0 ?
UL A 3 0 ?
OU S 4 0 ?
EP O 5 0 ?
CT N 6 0 ?
OV D 7 0 ?
EC J 8 0 ?
AN F 9 0 ?
EB M 10 0 ?
AR A 11 0 ?
PR M 12 0 ?
AY J 1 0 ?
UN J 2 0 ?
UL A 3 0 ?
UG 4 0 ?
Exemples
N° de ‘Décembre’ : ?NumMois("décembre") '12
N° de ‘Dèçënbre’ (avec fautes !) : ?NumMois("Dèçënbre") '12
N° de ‘February’ : ?NumMois("February") '2
N° de ‘Aug’ : ?NumMois("Aug") '8 - Août
N° de ‘ D e’ : ?NumMois(" D e") '12 - Décembre
N° de ‘JT’ : ?NumMois("JT") '7 - Juillet
N° de ‘JM’ : ?NumMois("JM") '0 - abréviation non reconnue
N° de ‘Marche pied’ : ?NumMois("Marche pied") '3 - Mars !!!
Performance
Compter au mieux 0,1 seconde pour 100 000 appels et 3 ou 5 fois plus de temps si présence de lettres accentuées.
@+
Philippe