Date et heure Omega Hour

[Bernard_XLD]

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]

'********************************************
'             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

 

[patricktoulon]

Good
on s'amuse comme des fous avec ce truc

 

[Bernard_XLD]

Re, le fil, le forum

Donc, pour info, 365 génère des matricielles même si elles ne sont pas nécessaires, le pire, c'est qu'on ne les voit pas sous 365 mais qu'elles apparaissent sur les versions antérieures !
Le seul truc que j'ai trouvé pour les désactiver, après avoir examiné des fichiers avec matricielles enregistrées sur des versions antérieures, est de placer @ entre le = et la formule, plus de matricielle, le fichier est compatible et les @ sont invisibles sur les versions antérieures.
=@Oh(B3;" heures ";" minutes ";" secondes")
Après tests, la matricielle dynamique est quasi systématique sur 365 avec les fonctions personnalisées.
ce simple code en déclenche une !

Function TestMatricielleAuto(arg1)
TestMatricielleAuto = arg1
End Function

=@TestMatricielleAuto(A1) règle le problème, on voit la différence en enregistrant le fichier en version xls d'abord sans @ puis avec, le premier déclenche une alerte de compatibilité matricielle dynamique, pas le deuxième.
J'ai posté dans le forum Trucs et astuces pour ça.

Bien cordialement, @+