Macro extraction donnees date en masse avec variable

Bonjour,

Je souhaiterais faire une extraction date sur un cellule qui contient du texte dans la colonne L.

La difficulté est que si il n'y a pas de données date dans la colonne L alors il faut faire une extraction dans la colonne M.

Par exemple dans la cellule L13: Extraction de la date 03/01/2022, pour la cellule M13 comme il n'y a pas de données date en L13 alors extraction dans M13. S'il n'y aucune donnée exploitable alors il y a un message dans la cellule "Donnée non exploitable"

E vous souhaitant une bonne journée

bonjour, avec une fonction personnalisée (je dois encore eliminer les textes),mais je ne comprends pas la problème en L13.

Function ExtractDate(s1, s2)
     ExtractDate = "-"
     For i = 1 To 2
          If i = 1 Then s = s1 Else s = s2

          If Len(s) > 0 Then
               sp = Filter(Split(s), "/", 1, 1)
               If UBound(sp) > -1 Then
                    For j = 0 To UBound(sp)
                         If sp(j) Like "*#/*#*/#*" Then s3 = s3 & " " & sp(j)
                    Next
                    If Len(s3) > 0 Then ExtractDate = Trim(s3): Exit Function
               End If
          End If
     Next
End Function

Le problème supplémentaire est qu'il y a différents format de date.. Il n'y a rien de formalisé ici

cela veut dire quoi ?

01/02/2022, 01-02-22, 01.02.22, ... = facile (avec le ".", on aura des conflicts avec les numéros téléphoniques)

Mais aussi "01 février 2022" ?

Encore d'autres ?

cette fonction, on peut l'aussi transformer en une macro.

Function ExtractDate(s1, s2)
     a = [text(date(1,column(a1:l1),1),"[$-fr-FR]mmmm;@")]
     ExtractDate = "-"
     For i = 1 To 2
          If i = 1 Then s = s1 Else s = s2

          If Len(s) > 0 Then

               Sp = Split(Replace(Replace(s, vbLf, " "), "-", "/"))
               fl = Filter(Sp, "/", 1, 1)

               If UBound(fl) > -1 Then
                    For j = 0 To UBound(fl)
                         If fl(j) Like "*#/*#*/#*" Then s3 = s3 & " " & fl(j)
                    Next

                    If Len(s3) > 0 Then
                         For j = 1 To Len(s3)
                              'ascii = Asc(Mid(s3, j, 1))
                              'If ascii <> 32 And (ascii < 47 Or ascii > 57) Then s3 = Replace(s3, ascii, "", , , vbTextCompare): j = j - 1
                         Next
                         If Len(s3) > 0 Then ExtractDate = Trim(s3): Exit Function
                    End If
               End If

               For j = 1 To UBound(a)
                    r = Application.Match(a(j), Sp, 0)
                    If IsNumeric(r) Then
                         If 1 < r And r < UBound(Sp) + 1 Then
                              If IsNumeric(Sp(r - 2)) And IsNumeric(Sp(r)) Then s3 = s3 & " " & Sp(r - 2) & "_" & Sp(r - 1) & "_" & Sp(r)
                         End If
                    End If
               Next
               If Len(s3) > 0 Then ExtractDate = Trim(s3): Exit Function

          End If
     Next
End Function

Bonjour à tous

Une proposition PowerQuery

Je reviens vers vous j'ai créé une première macro permettant de copier-coller ma source sur un autre fichier Excel, car c'est obligatoire dans ma situation.

J'essaie vos différentes solutions et je reviens vers vous.

Merci déjà pour vos réponses :)

Sub Extraction_V2()

    'définir les variables fichiers et onglets
    Dim Listefichier As Variant
    Dim Monclasseur As Workbook

    'on désactive le presse-papier
    Application.CutCopyMode = False

    'on efface les anciennes valeurs
    ActiveSheet.Range("A5").CurrentRegion.Clear

    'on récupère les données à copier
    Listefichier = Application.GetOpenFilename(Title:="Sélectionnez votre classeur", _
                   filefilter:="Fichiers Excel(*.xls*),*xls*", Buttontext:="Cliquez")

    'si bouton annuler
    If Listefichier <> False Then

        'on affecte le fichier sélectionner
        Set Monclasseur = Application.Workbooks.Open(Listefichier)
        'on copie les données
        Monclasseur.Sheets(1).Range("A12").CurrentRegion.Copy
        'on colle les données
        ThisWorkbook.ActiveSheet.Range("A5").PasteSpecial xlPasteValues
        'on désactive les messages d'alerte de Microsoft
        Application.DisplayAlerts = False
        'on ferme le classeur
        Monclasseur.Close

        End If

    'on réactive le presse-papier
        Application.CutCopyMode = True

End Sub

RE

elie50260 a écrit :

Je reviens vers vous j'ai créé une première macro permettant de copier-coller ma source sur un autre fichier Excel, car c'est obligatoire dans ma situation.

J'ai réussi à tout concaténer ma macro avec ta super formule PowerQuery et ça fonctionne! Merci beaucoup!

Maintenant, serait-il possible que tu m'expliques tes formules rentrées dans ce logiciel s'il te plaît?

 =Table.AddColumn(#"Type modifié", "Dat", each if Text.Contains([Description],"/202") then Text.End(Text.BeforeDelimiter([Description],"/202"),5) &"/202" & Text.Start(Text.AfterDelimiter([Description],"202"),1) 
else
if Text.Contains([Objet],"/202") then Text.End(Text.BeforeDelimiter([Objet],"/202"),5) &"/202" & Text.Start(Text.AfterDelimiter([Description],"202"),1) 
else 
if Text.Contains([Description]," 202") then Text.Reverse(Text.BetweenDelimiters(Text.Reverse(Text.End(Text.BeforeDelimiter([Description]," 202"),20) &" 202"),"202"," ",0,2))& " 202" &Text.Start(Text.AfterDelimiter([Description]," 202"),1) else 
if Text.Contains([Description],".202") then Text.End(Text.BeforeDelimiter([Description],".202"),5) &".202" & Text.Start(Text.AfterDelimiter([Description],"202"),1) else null)

Par exemple, je ne comprends pas le "/202"? Si je comprends tu divises le texte grâce une formule. Je souhaite la comprendre pour tenter de m'améliorer dans le codage :)

Bonne journée

RE

Pour chercher l'année j'utilise le slash ou le point ou l'espace suivi de 202 afin que cela fonctionne de 2020 à 2029 et je récupère ensuite le dernier caractère

Pour l'espace ensuite c'est tordu car pour trouver le mois en lettres et le jour, il faut partir de la fin et donc retourner le texte puis remettre les morceaux à l'endroit

Ah oui d'accord, par conséquent lorsque la donnée de de l'année est absente la formule sort une donnée "Null". Quel serait les axes selon toi pour l'extraire?

RE

Sans Années impossible de trouver une date dans de tels textes...

Ok merci de ta réponse, je vais continuer à chercher de mon côté. C'est possible que je te contacte en privé?

Agréable journée à toi :)

Bonjour

De façon limitée, oui

Le forum restant le moyen privilégié...