Découper un bloc de données avec une macro ?

Résolu
Bonjour

Je travaille sur un tableau d'environ 40 000 lignes qui contient sur plusieurs formats des données dont la base est un timbre + une date. Je veux séparer les deux. J'ai essayée en passant par donnée/convertir pour dissocier le timbre et la date. Mais voilà l'ensemble n'est pas calibré. Je deviens dingue pour rassembler les morceaux. Existe t il un moyen au travers d'une macro de pouvoir extraire ces deux données ?

je joins un petit tableau : https://www.cjoint.com/?3BoqnHfh9RL

Colonne A : données brutes
Colonne C et D : le résultat que je recherche
- le timbre commence par des chiffres ou par des lettres.
et la date peut être en lettre ou en chiffre (10/9/95; 10/09/1995; 10/05/1995 en plus un "." ou "/" ou "*" et tout ceci avec des espaces sup ou aucun espace c'est un peu l'anarchie.

merci par avance

Cordialement

10 réponses

  1. bonjour
    pour avoir la bomme date

    Sub Test()
    On Error Resume Next
       For L = 3 To Range("A" & Rows.Count).End(xlUp).Row
          Var = UCase(Cells(L, 1).Value)
          Cells(L, 3).Value = Split(Var, "DU")(0)
          MaDate = Trim(Split(Var, "DU")(1))
          MaDate = Replace(MaDate, ".", "")
          Cells(L, 4).Value = DateValue(MaDate)
       Next
    End Sub
    

    A+
    Maurice
    0
    1. Merci Maurice pour tes formules.
      0
  2. Bonjour

    Macro a mettre dans un module
    Sub Test()
    On Error Resume Next
       For L = 3 To Range("A" & Rows.Count).End(xlUp).Row
          Var = UCase(Cells(L, 1).Value)
          Cells(L, 3).Value = Split(Var, "DU")(0)
          MaDate = Trim(Split(Var, "DU")(1))
          Cells(L, 4).Value = Replace(MaDate, ".", "")
       Next
    End Sub
    


    apres si il manque le du il faut mettre a la main

    A+
    Maurice
    0
    1. Bonsoir à tous,

      une solution par formule si tu as Morefunc de Laurent Longre d'installé.
      c'est à base d'expressions régulières :

      SUBSTITUE(GAUCHE(A3;REGEX.TROUVE(A3;"\D\s*(du)*\s*\d{2}";;FAUX));" ";"/")
      pour la partie gauche
      et :
      =--REGEX.SUBSTITUE(REGEX.STXT(A3;"\d{2}(/|\s)*((01|02|03|04|05|06|07|08|09|10|11|12)|(JANVIER|FEVRIER|MARS|AVRIL|MAI|JUIN|JUILLET|AOUT|SEPTEMBRE|OCTOBRE|NOVEMBRE|DECEMBRE))(/|\s)*\d{4}";;VRAI);"(/|\s)*(JANVIER)|(FEVRIER)|(MARS)|(AVRIL)|(MAI)|(JUIN)|(JUILLET)|(AOUT)|(SEPTEMBRE)|(OCTOBRE)|(NOVEMBRE)|(DECEMBRE)(/|\s)*";"/[2=01;3=02;5=03;5=04;6=05;7=06;8=07;9=08;10=09;11=10;12=11;13=12]/")
      pour la date.

      J'ai testé sur 60 000 lignes, ça se calcule en 4 ou 5 secondes.

      cordialement
      0
      1. Bonjour

        j'ai un message d'erreur "#nom?"

        je suis en excel 2007
        0
      2. A annuler mon dernier commentaire je n'avais pas fait attention a ta fonction "Morefunc"
        0
      3. Bonjour

        Pour la date j'ai un message d'erreur " valeur" pour les dates en lettre "10 mai 1995" maintenant pour le reste cela fonctionne
        0
      4. @capeoBonjour,
        Je suis repassé en options régionales France pour avoir la bonne écriture :
        =--REGEX.SUBSTITUE(REGEX.SUBSTITUE(REGEX.STXT(A51;"\d{2}(/|\s)*((01|02|03|04|05|06|07|08|09|10|11|12)|(JANVIER|FEVRIER|MARS|AVRIL|MAI|JUIN|JUILLET|AOUT|SEPTEMBRE|OCTOBRE|NOVEMBRE|DECEMBRE))(/|\s)*\d{4}";;VRAI);"(/|\s)*(JANVIER)|(FEVRIER)|(MARS)|(AVRIL)|(MAI)|(JUIN)|(JUILLET)|(AOUT)(/|\s)*";"/[2=01,3=02,5=03,5=04,6=05,7=06,8=07,9=08,10=09,11=10,12=11,13=12]/");"(/|\s)*(SEPTEMBRE)|(OCTOBRE)|(NOVEMBRE)|(DECEMBRE)(/|\s)*";"/[1=09,2=10,3=11,5=12,5=12]/")

        cordialement
        0
      5. @JvDoBonjour

        Maintenant j'ai le message dès la 2 ème ligne.

        cdlt
        0
    2. Contributeur
      Au contraire ceux sont les DU qui nous aident. voici une nouvelle macro. Des que dans la ligne il n'y aura pas de DU, cela buggera. Il faudra corriger la ligne a la main en ajoutant un Du et relancer la macro:

      Sub For_X_to_Next_Ligne()
      Set FL1 = Worksheets("Feuil1")
          NoCol = 1 'lecture de la colonne 1
          For NoLig = 3 To Split(FL1.UsedRange.Address, "$")(4)
              Var = FL1.Cells(NoLig, NoCol).Value
              Var = UCase(Var) 'tout en majuscule
            Tableau = Split(Var, "DU")
           'boucle sur le tableau pour visualiser le résultat
          For i = 0 To UBound(Tableau)
              'Le résultat s'affiche dans la fenêtre d'execution de l'éditeur de macros
            '  Debug.Print Tableau(i)
             FL1.Cells(NoLig, 3).Value = Tableau(0)
             FL1.Cells(NoLig, 4).Value = Tableau(1)
          Next i
          Next
          Set FL1 = Nothing
      End Sub
      


      bon courage
      0
      1. Contributeur
        Bonjour Maurice, comme tu l'as constaté c'est la date qui va poser problème. Je n'ai pas trouvé un élément commun à toutes les lignes!!
        capeo, tu auras des bug car je pense que les dates ne commencent pas toutes par 10. Alors il faudra corriger la macro au fur et à mesure des dates, cela sera vite fastidieux!

        Un exemple:

        Sub For_X_to_Next_Ligne()
        Set FL1 = Worksheets("Feuil1")
            NoCol = 1 'lecture de la colonne 1
            For NoLig = 3 To Split(FL1.UsedRange.Address, "$")(4)
                Var = FL1.Cells(NoLig, NoCol).Value
                Var = Replace(Var, "10", "_ 10") 'a adapter la date, on ajoute_ pour scinder en 2
              Tableau = Split(Var, "_")
             'boucle sur le tableau pour visualiser le résultat
            For i = 0 To UBound(Tableau)
                'Le résultat s'affiche dans la fenêtre d'execution de l'éditeur de macros
              '  Debug.Print Tableau(i)
               Var_2 = Tableau(0)
                Var_2 = UCase(Var_2) 'tout en majuscule
                Var_2 = Replace(Var_2, "DU", "") 'supprime DU
             FL1.Cells(NoLig, 3).Value = Var_2
               FL1.Cells(NoLig, 4).Value = Tableau(1)
            Next i
            Next
            Set FL1 = Nothing
        End Sub


        les 10/05/1995 finissent à la ligne 100, il faudra mettre:

        For NoLig = 3 To 100

        à la place de

        For NoLig = 3 To Split(FL1.UsedRange.Address, "$")(4)

        après c'est 25/05/1995 jusqu'à la ligne 200

        on mettra

        For NoLig = 101 To 200

        mais ce n'est pas tout il faudra aussi corriger la date ici:

        Var = Replace(Var, "10", "_ 10") 'a adapter la date, on ajoute_ pour scinder en 2

        en mettant

        Var = Replace(Var, "25", "_ 25") 'a adapter la date, on ajoute_ pour scinder en 2

        Voilà, si tu te sens le courage. La difficulté vient du fait qu'il y a des lignes qui n'ont pas "du", sinon se sera du velours!

        0
        1. Bonsoir

          je suis très inquiet car le tableau à un grand nombre de ligne et de dates. Mais est il possible de supprimer le "du" de chaque ligne avant, si c'est cela qui pose problème?
          0
      2. Bonjour Le Pivert

        super ta macro mes la date Hum
        et moi je voie pas comment faire
        A+
        Maurice
        0
        1. Contributeur
          Je viens d'envoyer un classeur exemple
          0
          1. Merci pour la macro je vais faire des essais avec mes données. En cas je vous recontacterais si j'avais un bug.

            je vais donc clôturer le sujet

            quand pensez vous ?
            0
        2. bonjour

          Je suis débutant alors les macros se n'est pas simple.

          Macro 1: développeur/insérer un module, le module 1 est apparu j'ai coller la 1 ère macro dans la feuille j'ai insérer un bouton 1 que j'ai associé à For_X_to_Next_Ligne j'ai le résultat

          macro 2 : développeur/insérer un module, le module 2 est apparu j'ai coller la 2 ème macro dans la feuille j'ai insérer un bouton 2 mais là aucune macro à associer je n'ai que la macro 1

          Que faire ?

          merci
          0
          1. Contributeur
            Voici ton classeur:

            http://www.cjoint.com/data3/3Bor6QCy9Af.htm
            0
            1. Contributeur
              Bonjour,

              Voici une macro avec l'exemple donnée de date 10/05/1995. J'ai scindé en 2 à partir de 10. Si ce chiffre change, il faudra adapter la macro. C'est compliqué car il n'y a pas les mêmes références. du, DU et du absent aussi

              voici la macro:

              Option Explicit
              Dim FL1 As Worksheet, NoCol As Integer
              Dim NoLig As Long, Var As Variant
               Dim Tableau() As String
                  Dim i As Integer
              Private Sub CommandButton1_Click()
              For_X_to_Next_Ligne
              End Sub
              Sub For_X_to_Next_Ligne()
              Set FL1 = Worksheets("Feuil1")
                  NoCol = 1 'lecture de la colonne 1
                  For NoLig = 3 To Split(FL1.UsedRange.Address, "$")(4)
                      Var = FL1.Cells(NoLig, NoCol).Value
                      Var = Replace(Var, "10", "_ 10") 'a adapter la date, on ajoute_ pour scinder en 2
                    Tableau = Split(Var, "_")
                   'boucle sur le tableau pour visualiser le résultat
                  For i = 0 To UBound(Tableau)
                      'Le résultat s'affiche dans la fenêtre d'execution de l'éditeur de macros
                    '  Debug.Print Tableau(i)
                      FL1.Cells(NoLig, 3).Value = Tableau(0)
                       FL1.Cells(NoLig, 4).Value = Tableau(1)
                  Next i
                  Next
                  Set FL1 = Nothing
              End Sub
              


              0
              1. Contributeur
                J'ai oublié de supprimer les du à la fin:
                Private Sub CommandButton2_Click()
                Set FL1 = Worksheets("Feuil1")
                    NoCol = 3 'lecture de la colonne 3
                    For NoLig = 3 To Split(FL1.UsedRange.Address, "$")(4)
                        Var = FL1.Cells(NoLig, NoCol).Value
                      Var = UCase(Var) 'tout en majuscule
                        Var = Replace(Var, "DU", "")'supprime DU
                     FL1.Cells(NoLig, NoCol).Value = Var
                     Next
                    Set FL1 = Nothing
                End Sub
                
                0