Autres (RESOLU)Extraire une année composée de quatre chiffres ("aaaa")

[chaelie2015]

Bonsoir Forum
J'ai un texte alphanumérique de longueur variable dans la cellule B5. Mon objectif est d'extraire une année composée de quatre chiffres ("aaaa") à partir de cette chaîne et de l'afficher dans la cellule C5.
Exemple : Dans B5=49/2021 KDLP/04 donc j'aurai Dans C5= 2021
Merci

 

[Zon]

Salut tout le monde,

Dans le fichier de @mapomme , il y a des cellules où il y a 2 dates , en utilisant les fonctions de gbinforme et @laurent950 , j'extrais les 2 dates. Laurent si il y a 2 dates , il prend la 2 eme peut etre le souci de @chaelie2015 , si on prend que la 1ere garder la boucle mise en commentaire.

Mais en formule (sans fonction VBA ) , y a t-il moyen de faire du récursif avec 1 formule d'extraire 1 à n dates sur plusieurs cellules ??

Merci pour votre retour.

A+++

 

[mapomme]

Bonjour @Zon , à tous ,

Mais en formule (sans fonction VBA ) , y a t-il moyen de faire du récursif avec 1 formule d'extraire 1 à n dates sur plusieurs cellules ??

Voici une formule matricielle en D1 (à copier vers la droite et vers le bas) qui devrait le faire :

=SIERREUR(--STXT($D2;PETITE.VALEUR(SI(ESTERREUR(ANNEE("1/1/" & STXT($D2;LIGNE(INDIRECT("1:" &(NBCAR($D2)-3)));4)));"";LIGNE(INDIRECT("1:" &(NBCAR($D2)-3))));E$1);4);"")

Dans la formule, c'est le terme E$1 qui est le rang de l'année à extraire.

 

[Zon]

Bonjour,

Nickel Ma pomme , merci encore.

 

[mapomme]

Re,

Avec une fonction qui reproduit la formule. Tableau en ligne 13.

Function anneeN$(ByVal xs$, ByVal xn As Byte)
Dim i&, dat
   On Error Resume Next
   For i = 1 To Len(xs) - 3
      dat = "": dat = Mid(xs, i, 4)
      If dat Like "####" Then
         dat = CDate("1/1/" & dat)
         If dat <> "" Then
            dat = Year(dat)
            If dat > 1899 Then xn = xn - 1: If xn = 0 Then anneeN = dat: Exit Function
         End If
      End If
   Next i
End Function

 

[patricktoulon]

Bonjour à tous
la formule de @Phil69970 etait très bien il manquait juste la gestion d'erreur si non trouvé
=SIERREUR(DROITE(STXT(B5;CHERCHE("/???? ";B5);5);4);"")

 

[Phil69970]

Re

Merci Patrick mais apparemment je suis transparent car j'ai pas eu de retour sur ce post

 

[patricktoulon]

re
Bonjour @Phil69970
après il y a en effet (selon le classeur de @mapomme) un problème avec le "/" qui n'est pas toujours présent
mais bon comme d'habitude les demandeurs donnent le contexte au compte goutte

 

[TooFatBoy]

apparemment je suis transparent car j'ai pas eu de retour sur ce post

Personne, ou presque, n'est transparent. Voir cette photographie de Liu BOLIN (assis sur la chaise) :

 

[patricktoulon]

si on se passe du "/" ça passe
=SIERREUR(DROITE(STXT(B5;CHERCHE("???? ";B5);4);4);"")

 

[laurent950]

Bonsoir le Forum, @chaelie2015

J'ai corrigé le Poste #6 qui récupère bien les dates maintenant.

 

[chaelie2015]

Bonsoir le Forum, @chaelie2015

J'ai corrigé le Poste #6 qui récupère bien les dates maintenant.

Re
je vais voir
A+

 

[laurent950]

Re
Regex + Pattern avec recherches de Plusieurs Dates dans une cellules Excel

Option Explicit
Function ExtraireDate(Rng As Range) As String
    Dim Matches As Object
    Dim Match As Object
    Dim reg As Object
        Set reg = CreateObject("VBScript.RegExp")
    Dim CherchePattern(1 To 2) As Variant
    ' Stock Pattern dans une variable Tableau
    ' Aux Choix de la construction du pattern dans la case du tableau
          CherchePattern(1) = "\b\d{4}\b|d{4}"
          CherchePattern(2) = "(\d{4})" '"(^|\D)(\d{4})(\D|$)"
    ' Exemple ici c'est la case 2 du tableau
    ' Alors l'indice sera la case du tableau
    Dim N As Integer
        N = 2
    Dim i As Integer
' La date
    Dim Txt As String
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Set Rng = Rng.Cells(1, 1)
'   Recherche en Ligne :
' ---------------------
            reg.Pattern = CherchePattern(N) ' l'indice N sera = a la case du tableau.
            reg.MultiLine = True: reg.IgnoreCase = False: reg.Global = True: Debug.Print reg.test(Rng.Text)
            Set Matches = reg.Execute(Rng.Text)
            ' Cible de la recherche (Partie du Mots ou chaine recherché !)
            For Each Match In Matches
                'Debug.Print "source >>", Match.Value
'                For i = 0 To Match.SubMatches.Count - 1
'                    Debug.Print "[$" & i + 1 & "]", Match.SubMatches(i)
'                Next i
                    Txt = Txt & " / " & Match.Value
                    'Exit For
            Next Match
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' libération d'objets
    Set Matches = Nothing
    Set Match = Nothing
    Set reg = Nothing
    If Len(Txt) > 4 Then ExtraireDate = Right(Txt, Len(Txt) - 3) Else ExtraireDate = Txt
End Function

 

[patricktoulon]

Bonsoir laurent
purée!!! l'usine pour trouver une serie de 4 digits avec un regex
un petit exemple qui ne récupère que les nombre de 1900 a 2099
si tu les veux tous transforme ton matches en array et c'est tout

Function fourDigits(Rng As Range) As String
    Dim Matches As Object, Match As Object, reg As Object
    Dim CherchePattern
    Set reg = CreateObject("VBScript.RegExp")
    CherchePattern = "(19|20)+(\d{2})"
    reg.Pattern = CherchePattern    '
    reg.MultiLine = True: reg.IgnoreCase = False: reg.Global = True: Debug.Print reg.test(Rng.Text)
    Set Matches = reg.Execute(Rng.Text)
    If Matches.Count > 0 Then fourDigits = Matches(0)
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' libération d'objets
    Set Matches = Nothing
    Set Match = Nothing
    Set reg = Nothing
End Function

 

[laurent950]

Bonjour @patricktoulon

Je te remercie pour cette exemple que je vais conserver, ton code est épuré est super encore un grand merci.

Laurent

 

[patricktoulon]

re
ça fait longtemps que l'on c'est pas eu tout les deux
je constate que tu usine toujours avec les regex
c'est bien tu est curieux et c'est une qualité

quand on développe une fonction il ne faut pas perdre de vue l'objectif oui c'est sur
mais faut pas perdre de vue le reste(que tu a tendance à ignorer)

j'entends par là et je cite les plus importants

1. la lisibilité
2. la consommation utile(le regex peut être très lourd sur certaines configs)
3. l'organisation
4. la mixité d'utilisation vba/formule(sur ce coup là je t'ai suivi mais bon)

la mixité peut t'aider dans le developpement
en effet par exemple au lieu de rng as range j'aurais mis par exemple txt as string
ainsi tu peux tester directement avec une sub d'appel dans le module