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
|