charger de nombreux fichiers

[mimieloic]

Bonjour,

J'ai un probleme.
Enfin j'ai un nombre énorme de fichiers txt à transformer
Pour un fichier je sais le faire, mais j'aimerais le faire pour tous les fichiers en un seul clic
dans chaque fichier j'ai pleins de lignes, seules certaines lignes m'intéressent. ( ca je sais le faire par macro)
mais je voudrais pouvoir modifier tous mes fichiers INDEPENDEMMENT sans les ouvrir moi même un par un.

Avez vous une idéE?
mon programme pour un fichier
Sub remplacerCaracteres()
Application.ScreenUpdating = False

Dim Cell As Variant
Dim Valeur As Variant, Donnee As String
Dim Poire As Long
For Poire = 1 To 500000
Cells(Poire, 5) = "@*" 'Texte

Next Poire
Range("E5").NumberFormat = "@" 'Format texte
Range("I5").NumberFormat = "@" 'Format texte
Range("R5").NumberFormat = "@" 'Format texte

Cells(5, 5).Value = Cells(5, 4).Value

If Cells(5, 5) Like "81*" Then
For Each Cell In Selection
Cell.Value = Replace(Cell.Value, "0", "0000")
Cell.Value = Replace(Cell.Value, "1", "0001")
Cell.Value = Replace(Cell.Value, "2", "0010")
Cell.Value = Replace(Cell.Value, "3", "0011")
Cell.Value = Replace(Cell.Value, "4", "0100")
Cell.Value = Replace(Cell.Value, "5", "0101")
Cell.Value = Replace(Cell.Value, "6", "0110")
Cell.Value = Replace(Cell.Value, "7", "0111")
Cell.Value = Replace(Cell.Value, "8", "1000")
Cell.Value = Replace(Cell.Value, "9", "1001")
Cell.Value = Replace(Cell.Value, "A", "1010")
Cell.Value = Replace(Cell.Value, "B", "1011")
Cell.Value = Replace(Cell.Value, "C", "1100")
Cell.Value = Replace(Cell.Value, "D", "1101")
Cell.Value = Replace(Cell.Value, "E", "1110")
Cell.Value = Replace(Cell.Value, "F", "1111")

Next Cell
End If
Dim Boucle As Long
For Boucle = 1 To 78000
Cells(Boucle, 6).Value = Mid(Cells(Boucle, 5).Value, 75, 8)

If Cells(Boucle, 6) = 1 Then
Cells(Boucle, 7).Value = Mid(Cells(Boucle, 5).Value, 195, 2)
If Cells(Boucle, 7).Value = 1 Or Cells(Boucle, 7).Value = 10 Then
Cells(Boucle, 8).Value = Mid(Cells(Boucle, 5).Value, 223, 3)
If Cells(Boucle, 8).Value = 1 Then
Cells(Boucle, 9).Value = Mid(Cells(Boucle, 5).Value, 255, 32)
Else
Cells(Boucle, 9).Value = Mid(Cells(Boucle, 5).Value, 247, 32)
End If
Else
Cells(Boucle, 8).Value = Mid(Cells(Boucle, 5).Value, 210, 3)
If Cells(Boucle, 8).Value = 1 Then
Cells(Boucle, 9).Value = Mid(Cells(Boucle, 5).Value, 242, 32)
Else
Cells(Boucle, 9).Value = Mid(Cells(Boucle, 5).Value, 234, 32)
End If
End If

ElseIf Cells(Boucle, 6) = 0 Then
Cells(Boucle, 7).Value = Mid(Cells(Boucle, 5).Value, 171, 2)
If Cells(Boucle, 7).Value = 1 Or Cells(Boucle, 7).Value = 10 Then
Cells(Boucle, 8).Value = Mid(Cells(Boucle, 5).Value, 201, 3)
If Cells(Boucle, 8).Value = 1 Then
Cells(Boucle, 9).Value = Mid(Cells(Boucle, 5).Value, 233, 32)
Else
Cells(Boucle, 9).Value = Mid(Cells(Boucle, 5).Value, 225, 32)
End If
ElseIf Cells(Boucle, 7).Value = 0 Or Cells(Boucle, 7).Value = 11 Then
Cells(Boucle, 8).Value = Mid(Cells(Boucle, 5).Value, 186, 3)
If Cells(Boucle, 8).Value = 1 Then
Cells(Boucle, 9).Value = Mid(Cells(Boucle, 5).Value, 218, 32)
Else
Cells(Boucle, 9).Value = Mid(Cells(Boucle, 5).Value, 210, 32)
End If
End If
End If
Next Boucle
Cells(5, 10).Value = Mid(Cells(5, 9).Value, 1, 4)
Cells(5, 11).Value = Mid(Cells(5, 9).Value, 5, 4)
Cells(5, 12).Value = Mid(Cells(5, 9).Value, 9, 4)
Cells(5, 13).Value = Mid(Cells(5, 9).Value, 13, 4)
Cells(5, 14).Value = Mid(Cells(5, 9).Value, 17, 4)
Cells(5, 15).Value = Mid(Cells(5, 9).Value, 21, 4)
Cells(5, 16).Value = Mid(Cells(5, 9).Value, 25, 4)
Cells(5, 17).Value = Mid(Cells(5, 9).Value, 29, 4)
Dim Trou As Long
For Trou = 10 To 17
If Cells(5, Trou) = 0 Then Cells(5, Trou) = 0
If Cells(5, Trou) = 1 Then Cells(5, Trou) = 1
If Cells(5, Trou) = 10 Then Cells(5, Trou) = 2
If Cells(5, Trou) = 11 Then Cells(5, Trou) = 3
If Cells(5, Trou) = 100 Then Cells(5, Trou) = 4
If Cells(5, Trou) = 101 Then Cells(5, Trou) = 5
If Cells(5, Trou) = 110 Then Cells(5, Trou) = 6
If Cells(5, Trou) = 111 Then Cells(5, Trou) = 7
If Cells(5, Trou) = 1000 Then Cells(5, Trou) = 8
If Cells(5, Trou) = 1001 Then Cells(5, Trou) = 9
If Cells(5, Trou) = 1111 Then Cells(5, Trou) = ""


'Next Cell
[R5] = [J5] & "" & [K5] & "" & [L5] & "" & [M5] & "" & [N5] & "" & [O5] & "" & [P5] & "" & [Q5]

Next Trou
Dim Banane As Long
For Banane = 1 To 78000
Cells(Banane, 5).Value = Cells(5, 18).Value

Next Banane
Dim i As Long
For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
Next

Range("F:R").EntireColumn.Hidden = True


For i = 1 To 500

If Cells(i, 4).Value = "81*" Then
Rows("i:i").EntireRow.Hidden = True
End If

Next

End Sub

Sub Test()
Application.ScreenUpdating = False
Dim Fichier As String, Chemin As String
Dim i As Long

'Répertoire contenant les fichiers
Chemin = "C:\Users\9305743N\Desktop"
Fichier = Dir(Chemin & "\*.eur")

'Boucle sur les fichiers
Do While Fichier <> ""

i = Range("A1000000").End(xlUp).Row + 1
ImportText Chemin & "\" & Fichier, Cells(i, 1)

Fichier = Dir
Loop
Dim Boucle As Long
For Boucle = 1 To 78000
Cells(Boucle, 2).Value = Mid(Cells(Boucle, 1).Value, 1, 10)
Cells(Boucle, 3).Value = Mid(Cells(Boucle, 1).Value, 12, 8)
Cells(Boucle, 4).Value = Mid(Cells(Boucle, 1).Value, 37, 100)

Next Boucle


For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If Not (Cells(i, 4) Like "88*" Or Cells(i, 4) Like "81*") Then Rows(i).Delete
Range("A:A").EntireColumn.Hidden = True

Next
Columns("D").Select
Selection.Sort Key1:=Range("D1")

End Sub

Sub ImportText(NomFichier As Variant, Cible As Range)
Dim QT As QueryTable

Set QT = ActiveSheet.QueryTables.Add(Connection:="TEXT;" & _
NomFichier, Destination:=Cible)

With QT
'Définit les séparateur de colonnes dans le fichier txt
.TextFileOtherDelimiter = ";"
.TextFileSemicolonDelimiter = True
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.Refresh
End With
End Sub




j'effectue le test dans le deuxieme programme et ensuite remplacer caractre() je voudrais faire pareil mais en un seul clic
Merci d'avance

 

[ERIC S]

Re : charger de nombreux fichiers

Bonjour

je n'ai pas tout lu.......
en pièce jointe un exemple de macro qui balaye un répertoire
je l'ai utilisée pour des xls, pas testé avec des txt

tu cliques sur le bouton
boite de dialogue : tu vas dans le répertoire qui t'intéresse et tu cliques sur un des fichiers proposés (mémorise le chemin)
la macro liste ensuite tous les xls

en adaptant aux txt cela peut peut-être t'aider, si tes fichiers sont tous dans le même répertoire