XL 2019 Extraction jour (deux lettres) et heures associées

thespeedy20

XLDnaute Occasionnel
Bonjour,

Une colonne avec des jours et heure associée de type

MA 15:30 à 19:00
JE à déterminer
SA 15:00

J'aimerais que l'on puisse extraire dans le jour, puis l'heure, en sachant qu'il peut y avoir plusieurs espaces entre le jour et l'heure

Cela donnerait

HoraireJourHeure
MA 15:30 à 19:00MA15:30 à 19:00
JE à déterminerJEà déterminer
SA 15:00SA15:00

Je vous en remercie par avance... je joins mon fichier avec un petit millier de lignes, sachant que j'ai certains fichiers allant jusque 15.000 lignes...
 

Pièces jointes

  • Extraction.xlsx
    17.6 KB · Affichages: 5

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour,
Un essai en PJ, la mise à jour est automatique quand on modifie une valeur de la colonne A.
Je passe par des arrays pour accélérer le processus, avec :
VB:
Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [A:A]) Is Nothing Then
        Dim tablo, tablosortie, L%, DL%
        Application.ScreenUpdating = False
        DL = Range("A65500").End(xlUp).Row                                          ' Dernière ligne
        [B:C].ClearContents                                                         ' Effacement matrice de sortie
        tablo = Range("A1:A" & DL)                                                  ' Tranfert données dans array, beaucoup plus rapide
        ReDim tablosortie(DL, 2)                                                    ' Création tableau de sortie
        For L = 2 To UBound(tablo)
            If tablo(L, 1) <> "" Then
                tablosortie(L - 1, 0) = Left(tablo(L, 1), 2)                        ' Extraction Jour
                tablosortie(L - 1, 1) = Trim(Mid(tablo(L, 1), 3, Len(tablo(L, 1)))) ' extraction heure
            End If
        Next L
        [B1].Resize(UBound(tablosortie, 1), UBound(tablosortie, 2)) = tablosortie   ' restitution tableau en B et C
        [B1] = "Jour": [C1] = "Heure"                                               ' Entete
        Columns("C:C").HorizontalAlignment = xlCenter                               ' Centré
        Application.ScreenUpdating = True
    End If
End Sub
NB : Erreur de parenthèses :
Code:
Trim(Mid(Cells(x, 1).Value, 3, Len(Cells(x, 1).Value)))
au lieu de
Trim(Mid(Cells(x, 1).Value), 3, Len(Cells(x, 1).Value))
 

Pièces jointes

  • Extraction (2).xlsm
    35.7 KB · Affichages: 2

patricktoulon

XLDnaute Barbatruc
Bonjour à tous
c'est assez simple comme truc a faire
il te faut splitter le text par le premier espace
comme tu a des cellules vides il te faut ajouter un espace a la fin (qui sera supprimé ensuite
voila donc la chose en VBA en version simplissime j'i mis un bouton sur la feuille
VB:
Sub Bouton1_Cliquer()
    Dim tableau, x, j$, I&
    tableau = ActiveSheet.Range("A2:b2").Resize(Cells(Rows.Count, "A").End(xlUp).Row - 1)
    For I = 1 To UBound(tableau)
        x = Split(tableau(I, 1) & " ", " ")
        j = x(0)
        tableau(I, 2) = trim(Replace(tableau(I, 1), j, ""))
        tableau(I, 1) = j
    Next
    With [B2].Resize(UBound(tableau), 2)
    .ClearContents
    .Value = tableau
End With
End Sub
 

Pièces jointes

  • Extraction jour heure V PAT.xlsm
    26.6 KB · Affichages: 5

patricktoulon

XLDnaute Barbatruc
Bonjour
et oui tu t'es contenté de tester le fichier sans faire la correction trim que je fait dans le code que je t'ai donné
il faut pas lire en diagonale ou se contenter de récupérer un fichier il faut tout lire ;)
de temps en temps je test les gens comme ça pour voir si ils lisent tout ou se contente de ce qu'on leur donne en terme de fichier
bon ben c'est un zero pointé pour toi aujourd'hui hein ;)
bon c'est pas grave maintenant tu sais ;)
 

Discussions similaires