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

Question

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

cs_Le Pivert · Answer

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

cs_Le Pivert · Answer

Voici ton classeur:

 http://www.cjoint.com/data3/3Bor6QCy9Af.htm

capeo · Answer

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

cs_Le Pivert · Answer

Je viens d'envoyer un classeur exemple

Maurice · Answer

Bonjour Le Pivert

super ta macro mes la date Hum
et moi je voie pas comment faire
A+
Maurice

cs_Le Pivert · Answer

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!

cs_Le Pivert · Answer

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

JvDo · Answer

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

Maurice · Answer

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

Maurice · Answer

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

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

10 réponses

Votre réponse

Discussions similaires

Newsletters