Rapport de message :*
 

Re: suppression de lignes vides ou de valeurs zéro'(0) dans une plage donnée

Titre du sujet : Re: suppression de lignes vides ou de valeurs zéro'(0) dans une plage donnée
par Mth le 21/05/2010 11:11:51

Bonjour ali08, Guy

Après pas mal de recherches, j'ai eu la chance de découvrir un code écrit par Silkyroad permettant d'importer des fichiers textes de plus de 65536 lignes en les ventilant dans plusieurs onglets.
J'ai ensuite tenté d'écrire la suite pour convertir les données et effacer les lignes vides ou à zéro, mon code n'est bien sûr pas à la hauteur de celui de Silkyroad mais ça fonctionne de mon coté, vois si cela peut t'aider ?

Option Explicit
'Code d'importation fourni par Silkyroad sur developper.com
Sub import()
Dim Fichier As Variant
    ChDir ThisWorkbook.Path
    Fichier = Application.GetOpenFilename("Fichier TXT (*.txt), *.txt")
    If Fichier <> False Then Extraction Fichier, 65536, ";"
End Sub

Private Sub Extraction(ByVal Fichier As String, ByVal NbLignesParFeuille As Long, ByVal Separateur As String)
Dim Wb As Workbook
Dim Counter As Long, Cpt As Long
Dim Tableau() As String
Dim i As Long
Dim ContenuLigne As String

    Application.ScreenUpdating = False

    Counter = 1: Cpt = 1
    Set Wb = Workbooks.Add(1)

    Open Fichier For Input As #1
        Do While Not EOF(1)
            If Counter > NbLignesParFeuille Then
                Wb.Worksheets.Add
                Counter = 1
            End If
   
            Line Input #1, ContenuLigne
            Tableau = Split(ContenuLigne, Separateur)
   
            For i = 0 To UBound(Tableau)
                ActiveSheet.Cells(Counter, i + 1) = Tableau(i)
            Next i
           
            Application.StatusBar = Cpt
            Cpt = Cpt + 1
            Counter = Counter + 1
        Loop
    Close #1
   
'************************
'suite
'************************

Dim sh As Worksheet, x As Long

For Each sh In ActiveWorkbook.Worksheets

    If sh.Range("A1") <> "" And sh.Range("A1") <> "_______________________________________________________________________________" Then
        sh.Columns("A:A").TextToColumns Destination:=sh.Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="|", FieldInfo:=Array(Array(1, 9), Array(2, 2), Array(3, 4), Array(4, 1), Array(5, _
        1)), TrailingMinusNumbers:=True
   
            For x = sh.[A65536].End(xlUp).Row To 1 Step -1
                If Application.CountIf(sh.Rows(x), "=0") > 0 Or Application.CountIf(sh.Rows(x), "*") = 0 Then sh.Rows(x).Delete
            Next x
    End If

Next sh


    Application.ScreenUpdating = True
    MsgBox "Opération terminée"
End Sub


 

Bonne journée à tous,

Mth

Edit: ajout du fichier en PJ