Bonjour a tous
@Bernard_XLD et @patricktoulon vous présentent Omega Hour, la fonction Oh "à la fin, je suis une heure".
Partant d'une idée, Patrick et moi avons développé cette fonction de conversion horaire.
Elle transcrit toute valeur ou texte, interprétable en horaire, en valeur horaire.
Dans une cellule ou passé en argument, valeur ou texte, positif ou négatif, avec séparateur deux points, virgule, point, point virgule, espace, apostrophe, underscore, signe moins, séparateurs personnalisés ou même sans séparateurs, elle comprend tout.
Utilisable en formule ou Vba.
Pratique pour convertir des données importées ou des saisies manuelles, elle est aussi utilisable avec les fonctions de calcul d'Excel pour travailler directement avec les données brutes.
[édition : compatible et prévue de base pour travailler avec Omega String, elle permet aussi de travailler et d'afficher correctement les heures négatives en calendrier 1900]
@Bernard_XLD et @patricktoulon vous présentent Omega Hour, la fonction Oh "à la fin, je suis une heure".
Partant d'une idée, Patrick et moi avons développé cette fonction de conversion horaire.
Elle transcrit toute valeur ou texte, interprétable en horaire, en valeur horaire.
Dans une cellule ou passé en argument, valeur ou texte, positif ou négatif, avec séparateur deux points, virgule, point, point virgule, espace, apostrophe, underscore, signe moins, séparateurs personnalisés ou même sans séparateurs, elle comprend tout.
Utilisable en formule ou Vba.
Pratique pour convertir des données importées ou des saisies manuelles, elle est aussi utilisable avec les fonctions de calcul d'Excel pour travailler directement avec les données brutes.
[édition : compatible et prévue de base pour travailler avec Omega String, elle permet aussi de travailler et d'afficher correctement les heures négatives en calendrier 1900]
VB:
'********************************************
' Fontion Oméga Hour (Oh), "à la fin, je suis une heure"
' V 1.0 en date du 19/05/2021
'cette fonction convertit en valeur horaire toute valeur ou texte interprétable
'hors séparateurs traités en natif (liste exaustive dans ArraySep), les séparateurs exotiques sont traités par utilisation des séparateurs optionnels Sep1 et Sep2
'Sup_Chn effacera la valeur correspondante dans le format(ex: secondes dans un texte au format HH" heures "MM" minutes "SS" secondes").
'Cette fonction est utilisable en encapsulage avec les fonctions de calcul d'Excel en renvoyant un tableau de valeurs horaires
'
'auteurs : Bernard_XLD & patricktoulon sur ExcelDownloads
'
'V 1.1 en date du 21/05/2021, traitement unique en tableau
'V 1.2 en date du 21/05/2021 suppression du select case et gestion d'erreur dans la boucle TabRange + test string de fausse valeur horaire
'V 1.3 en date du 22/05/2021 correction d'un bug mineur sur les séparateurs en argument, intégration de séparateurs par défaut supplémentaires, optimisation du moteur
'**********************************************
Function Oh(Valeur, Optional Sep1$ = "", Optional Sep2$ = "", Optional Sup_Chn$ = "")
Dim TabRange, ArraySep, i&, y&, z&, Neg As Boolean, NVal As Boolean, Dbl3dec As Boolean
ArraySep = Split(Trim(Sep1) & "|" & Trim(Sep2) & "|heures|heure|hrs|hr|hs|h|minutes|minute|mns|mn|ms|m|secondes|seconde|sec|ss|s|,|;|-|_|.|'| :|: | ", "|")
ReDim TabRange(1 To 1, 1 To 1): TabRange(1, 1) = Valeur
If TypeName(Valeur) = "Range" Then If Valeur.Count > 1 Then TabRange = Valeur.Value2: NVal = True Else TabRange(1, 1) = Valeur.Value2
On Error Resume Next
For y = LBound(TabRange, 1) To UBound(TabRange, 1)
For z = LBound(TabRange, 2) To UBound(TabRange, 2)
If Not TabRange(y, z) = "" Then
Dbl3dec = False
If InStrRev(StrReverse(TabRange(y, z)), ",") > 3 And IsNumeric(TabRange(y, z)) Then If Not CLng(CDec(TabRange(y, z)) * 100) = CDec(TabRange(y, z)) * 100 Then TabRange(y, z) = CDbl(TabRange(y, z)): Dbl3dec = True
If Not Dbl3dec Then
Neg = (Left(TabRange(y, z), 1) = "-"): If Neg Then TabRange(y, z) = Mid(TabRange(y, z), 2)
If Not Sup_Chn = "" Then TabRange(y, z) = Replace(TabRange(y, z), Sup_Chn, "")
TabRange(y, z) = LCase(Trim(TabRange(y, z)))
For i = 0 To UBound(ArraySep)
If InStr(1, TabRange(y, z), ArraySep(i)) Then TabRange(y, z) = Replace(TabRange(y, z), ArraySep(i), ":")
Next i
If Right(TabRange(y, z), 1) = ":" Then TabRange(y, z) = Left(TabRange(y, z), Len(TabRange(y, z)) - 1)
If InStr(1, TabRange(y, z), ":") = 0 Then TabRange(y, z) = TabRange(y, z) & ":00" Else If Right(TabRange(y, z), 2) Like ":?" Then TabRange(y, z) = TabRange(y, z) & "0"
TabRange(y, z) = WorksheetFunction.Product(TabRange(y, z)) * IIf(Neg, -1, 1)
If Err.Number > 0 Then TabRange(y, z) = Error(5): Err.Clear
End If
End If
Next z
Next y
Oh = IIf(NVal, TabRange, TabRange(1, 1))
End Function
Dernière édition: