Extraire la date d'une chaine

Bonjour à tous, je cherche une solution pour extraire la date qui figure plusieurs fois dans une ligne :

28/09/2018 16:32:00 28/09/2018 17:52:56 28/09/2018 21:54:12 28/09/2018 22:55:32

J'aimerai que cette ligne puisse se mettre sous cette forme :

28/09/2018 16:32:00 17:52:56 21:54:12 22:55:32

Merci d'avance !

Bonjour Ecirbaf54 ,

Admettons que ta chaîne se situe en "A1", voilà un code qui va extraire les mots espacés par un espace

Sub extraction()
    Dim Tableau() As String
    Dim i As Integer

    Tableau = Split(Range("A1"), " ")

    For i = 0 To UBound(Tableau)
        Range("A" & i) = Tableau(i)
    Next i
End Sub

Merci beaucoup Florian, seulement je ne suis pas trop (du tout ?) à l'aise avec les macros... à quel endroit entrer ces commandes et comment l'exécuter...

Bonjour Fabrice, bonjour le forum,

Essaie comme ça (à adapter) :

Sub Macro1()
Dim D As String 'déclare la variable D (Dates)
Dim R As String 'déclare la variable R (Résultat)

D = Split(Cells(1, "A").Value, " ")(0) 'définit la date D & " "
For I = 0 To UBound(Split(Cells(1, "A").Value, D)) 'boucle sur toutes les fois que la dates D apparaît
    R = IIf(R = "", D & Split(Cells(1, "A").Value, D)(I), R & " " & Split(Cells(1, "A").Value, D)(I)) 'définit le résultat R
Next I 'prochaine fois
MsgBox R 'message affichant le résultat
End Sub

[Édition]

Ho p... ! Encore trop lent... Bonjour Florian

Re,

@ ThauThème: Peut être trop lent, mais tu réponds au problème du 1er coup , Moi non

Je viens de relire ton problème et en fait sa ne convient pas totalement, essaye ceci pour n'inscrire qu'une seul fois la date

Sub extraction()
    Dim Tableau() As String
    Dim i As Integer

    Set MonDico = CreateObject("Scripting.Dictionary")

    Tableau = Split(Range("A1"), " ")

    For i = 0 To UBound(Tableau)
        If Tableau(i) <> "" Then MonDico(Tableau(i)) = Tableau(i)
    Next i

    [A2].Resize(MonDico.Count) = Application.Transpose(MonDico.items)
End Sub

Merci ThauTheme, la macro s'exécute bien mais comment coller le résultat dans une cellule ?

Mon post précédent collent les résultats en ligne, le code qui suit les collent en colonnes :

Sub extraction()
    Dim Tableau() As String
    Dim i As Integer

    Set MonDico = CreateObject("Scripting.Dictionary")

    Tableau = Split(Range("A1"), " ")

    For i = 0 To UBound(Tableau)
        If Tableau(i) <> "" Then MonDico(Tableau(i)) = Tableau(i)
    Next i

    [A2].Resize(1, MonDico.Count) = (MonDico.items)
End Sub

Florian, après avoir essayé les 2 macros, elles collent toutes 2 en colonne... en ligne ça m'arrangerait !

Sinon comment l'exécuter sur x lignes ?

Merci !

Re,

à adapter :

Range("C1").value=R

[Édition]

La méthode de Florian sera beaucoup plus rapide sur un grand nombre de lignes...

Sub Macro1()
Dim DL As Integer 'déclare la variable DL (Dernière ligne)
Dim D As String 'déclare la variable D (Dates)
Dim R As String 'déclare la variable R (Résultat)
Dim I As Integer 'déclare la variable I (incrément)

DL = Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A
For I = 1 To DL 'boucle sur toutes les lignes I de 1 à DL
    D = Split(Cells(1, "A").Value, " ")(0) 'définit la date D & " "
    For I = 0 To UBound(Split(Cells(1, "A").Value, D)) 'boucle sur toutes les fois que la dates D apparaît
        R = IIf(R = "", D & Split(Cells(1, "A").Value, D)(I), R & " " & Split(Cells(1, "A").Value, D)(I)) 'définit le résultat R
    Next I 'prochaine fois
    Cells(I, "C").Value = R 'renvoie R dans la colonne C
Next I 'prochaine ligne de la boucle
End Sub

Transmets nous un fichier exemple afin que l'on puisse l'adapter

Voici un exemple en PJ...

Voici ton fichier en retour:

Re,

Le code que je te proposais dans mon dernier post n'étais pas bon. Voici :

Sub Macro1()
Dim DL As Integer 'déclare la variable DL (Dernière ligne)
Dim D As String 'déclare la variable D (Dates)
Dim R As String 'déclare la variable R (Résultat)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable I (incrément)

DL = Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A
For I = 2 To DL 'boucle sur toutes les lignes I de 1 à DL
    D = Split(Cells(I, "A").Value, " ")(0) 'définit la date D & " "
    For J = 0 To UBound(Split(Cells(I, "A").Value, D)) 'boucle sur toutes les fois que la dates D apparaît
        R = IIf(R = "", D & Split(Cells(I, "A").Value, D)(J), R & " " & Split(Cells(I, "A").Value, D)(J)) 'définit le résultat R
    Next J 'prochaine fois
    Cells(I, "C").Value = R 'renvoie R dans la colonne C
Next I 'prochaine ligne de la boucle
End Sub

@ Florian

Pourquoi en colonne C la même date 20/09/2018 ? Il manque une remise à zéro quelque part...

@ ThauThème, effectivement mon RemoveAll n'était pas placé au bon endroit, rapidité et efficacité ne font pas bon ménage

Sub extraction()
    Dim Tableau() As String
    Dim i As Integer

    derlgn = Range("A" & Rows.Count).End(xlUp).Row

    Set Mondico = CreateObject("Scripting.Dictionary")

    For j = 2 To derlgn

        Tableau = Split(Cells(j, 1), " ")

        For i = 0 To UBound(Tableau)
            If Tableau(i) <> "" Then Mondico(Tableau(i)) = Tableau(i)
        Next i

        Cells(j, 2).Resize(1, Mondico.Count) = (Mondico.items)
        Mondico.RemoveAll
    Next j

End Sub

Re,

Yes ! Y'a pas photo... Je recommande vivement.

J'ai fais un timer sur les 2 macros, le temps d’exécution est vraiment très similaire pour ce nombre de ligne ( environ 0,10 secondes pour les 2 )

Merci Florian, ça fonctionne très bien.

Quel paramètre modifier si la première cellule n'est pas A2 mais C3 par exemple ?

Il faut changer la valeur de départ de "j":

For j = 3 To derlgn