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

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

Voici ton classeur:

http://www.cjoint.com/data3/3Bor6QCy9Af.htm

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

Je viens d'envoyer un classeur exemple

Bonjour Le Pivert

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

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!

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

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

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

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