[RESOLU] Extraire certaines lignes d'un classeur.

[Icedarts]

Bonjour à tous,

Après avoir résolu mes petits problèmes de mise en forme dans mon fichier csv (environ 20 000 lignes) il me faut maintenant supprimer tout ce qui ne m’intéresse pas ou extraire juste ce qui m’intéresse en fonction de la solution la plus simple pour vous.

Dans le classeur joint je vous ai surligné la partie à conserver, sachant qu'elle se répète dans le classeur et que je dois tout conserver.

Je ne sais pas comment extraire les parties entre le premier "*TEAMNAME" et les "********"
Les parties a conserver sont toujours identiques:
Première ligne commence par *TEAMNAME
Dernière ligne celle avant les ***********

Voila si quelqu'un a une idée ça serait sympa car récupérer manuellement ces quelques lignes dans un aussi grand fichier c'est assez fastidieux!

Merci d'avance.

 

[Compte Supprimé 979]

Re : Extraire certaines lignes d'un classeur.

Salut Icedarts,

Essaye ce code qui nettoie la feuille active

Sub SupressionLigneEnTrop()
  Dim DLig As Long, Lig As Long
  Dim FlgSup As Boolean, MemFlg As Boolean
  ' Initialiser les variables
  FlgSup = True: MemFlg = False
  ' Avec la feuille active
  With ActiveSheet
    ' Récupérer le numéro de la dernière ligne
    DLig = .Range("A" & Rows.Count).End(xlUp).Row
    ' A partir de la fin vers la 1ère ligne
    For Lig = DLig To 1 Step -1
      ' Sélectionner la cellule A de la ligne : Lig
      .Range("A" & Lig).Select
      ' Si la cellule contient des étoiles
      If InStr(1, .Range("A" & Lig), "*****") > 0 Then
        ' Si le flag mémoire est faux
        If MemFlg = False Then
          ' Passer le flag mémoire à VRAI
          MemFlg = True
          ' Passer le flag de suppression de ligne à FAUX
          FlgSup = False
          ' Supprimer la ligne contenant les étoiles
          .Rows(Lig).EntireRow.Delete
        Else  ' Si le flag mémoire est VRAI
          ' Passer le flag à FAUX
          MemFlg = False
          ' Passer le sflag de supression de ligne à VRAI
          FlgSup = True
        End If
      End If
      ' Si le flag de supression de ligne est VRAI
      If FlgSup = True Then
        ' On surpprime la ligne
        .Rows(Lig).EntireRow.Delete
      End If
    Next Lig
  End With
End Sub

A+

 

[Icedarts]

Re : Extraire certaines lignes d'un classeur.

Alors sur le fichier test ça fonctionne.
Sur mon plus gros fichier (40 000 lignes) ton code mets environ 2min et ne ressort pas les bonnes lignes.
Il faut surement que tu vois le fichier en entier pour comprendre le problème.
Tu peux le télécharger ici:
Ce lien n'existe plus

Dans ce fichier il y aurait 3 parties à extraire:
lignes 144 à 203
lignes 6816 à 6891
lignes 17208 à 17260

Merci pour ton aide.

 

[Compte Supprimé 979]

Re : Extraire certaines lignes d'un classeur.

Re,

Désolé, ça peut effectivement être long, voici le code qui extrait les données

Sub ExtractionDonnees()
  Dim DLig As Long, Lig As Long
  Dim RngF1 As Range, RngF2 As Range, FirstLig As Long
  ' Ajouter une feuille dans le classeur
  Sheets.Add After:=Sheets(1)
  ' Initialiser les variables
  Lig = 1: FirstLig = 1
  ' Avec la feuille active
  With Sheets(1)
    .Activate
    ' Récupérer la dernière ligne remplie
    DLig = .Range("A" & Rows.Count).End(xlUp).Row
    ' Rechercher la valeur souhaitée
    Set RngF1 = .Range("A" & Lig & ":A" & DLig).Find(What:="Information de Stats de joueur", _
                                    LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
                                    SearchDirection:=xlNext, MatchCase:=False)  ' After:=ActiveCell
    Do While Not RngF1 Is Nothing
      Lig = RngF1.Row
      ' Trouver la ligne contenant les étoiles (faire précéder les étoiles d'un tildé)
      Set RngF2 = .Range("A" & Lig & ":A" & DLig).Find(What:="~*~*~*~*", _
                LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False)
      ' Selection des lignes pour avoir un visuel (pas obligatoire)
      .Rows(RngF1.Row & ":" & RngF2.Row - 1).Select
      ' Couper la sélection
      Selection.Copy Destination:=Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
      Selection.ClearContents
      ' Mémoriser le numéro de la dernière ligne trouvée
      Lig = RngF2.Row
      ' Rechercher de nouveau la valeur souhaitée
      Set RngF1 = .Range("A" & Lig & ":A" & DLig).Find(What:="Information de Stats de joueur", _
                                      LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
                                      SearchDirection:=xlNext, MatchCase:=False)
    Loop
  End With
  Sheets(2).Activate
  MsgBox "C'est fini"
End Sub

A+

 

[Icedarts]

Re : Extraire certaines lignes d'un classeur.

Alors je viens de tester, a priori ça fonctionne au poil!
Et tu as du changer quelque chose car même sur les 40 000 lignes ça n'a pas pris 2 secondes!
Merci beaucoup!