Discussion :

[arnest]

Bonjour à Tous

Je cherche a appliquer un filtre élaboré sur plusieurs fichiers texte dans un même répertoire ayant toujours la même structure des données via ce code.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
 
Sub Ellipse1_QuandClic()
Dim Repertoire1 As String, Fichier As String, Repertoire2 As String, zone As String, zonec As String
Dim fresultat As String, nomfich As String, nomfeuile As String, fichierc As String
Dim Wb As Workbook
Dim Wc As Workbook
Dim Ws As Worksheet
Dim Wv As Worksheet
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
'Zone de Critéres
 
    fichierc = "C:\Stock\Oasis\critéres.xls"
    Set Wc = Workbooks.Open(fichierc)
    Windows("critéres.xls").Activate
    Sheets(1).Select
    b = Sheets(1).Range("C65536").End(xlUp).Row
    zonec = "A1:AJ" & b
 
 
 
    Repertoire1 = "C:\Stock\Oasis\Brute\"
    Repertoire2 = "C:\Stock\Oasis\Tr1\"
    i = 1
 
 
'Spécifie la recherche pour le fichiers .xls
 
 
Fichier = Dir(Repertoire1 & "*.xls")
 
 
 
'Boucle sur les fichiers du répertoire
 
Do While Fichier <> ""
 
            Fich = Repertoire1 & Fichier
            Set Wb = Workbooks.Open(Fich) 'ouverture du fichier
            Set Ws = Wb.Sheets(1)
 
 
 
                'Filtre
                Ws.Select
                b = Ws.Range("A65536").End(xlUp).Row
                zone = "A1:AJ" & b
 
                Range("A1").Select
                Range(zone).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
                Workbooks("critéres.xls").Sheets(1).Range(zonec), Unique:=False
                nomfich = Wb.Name
                nonfeuil = Ws.Name
                Ws.Select
                b = Ws.Range("A65536").End(xlUp).Row
                zone = "A1:AJ" & b
                Range(zone).Select
                Selection.Copy
                Workbooks.Add
                'ActiveWorkbook.Name = nomfich
                'Sheets(1).Name = nomfeuil
                ActiveSheet.Paste
                Application.CutCopyMode = False
                fresultat = Repertoire2 & nomfich
                ActiveSheet.Name = nonfeuil
                Wb.Close
 
                ActiveWorkbook.SaveAs Filename:=fresultat, FileFormat:=xlNormal, _
                Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
                CreateBackup:=False
                ActiveWorkbook.Close
 
                Fichier = Dir
 
 
Loop
 
End Sub

Ceci marche sauf deux cas:
1- le fichier ne contient que la ligne d'entête
2- le fichier étant texte ayant plus de 63536 lignes

Comment je peut corriger ce code?

[zazaraignée]

Si ton fichier ne contient que les entêtes (première ligne), il est possible d'appeler une petite macro (ou d'inclure le code dans ta procédure) qui teste le résultat d'un End.xlDown. Si ce résultat est inférieur à la dernière ligne de la feuille excel (65536, je crois), le fichier est bon...

Si ton fichier contient plus de 65536 lignes (incluant les entêtes de colonnes), il devrait se produire une erreur. En récupérant cette erreur, tu devrait pouvoir la gérer (afficher un message et / ou passer au fichier suivant).

[arnest]

Merci d'avoir répondu à ma requête.

Je ne vois pas comment la faire ce test avez vous une idée?

[zazaraignée]

Si j'ai bien compris ton code, tu ouvres des fichiers .txt dans Excel qui affiche les données dans les cellules d'une feuille...

De là, la cellule active (la sélection par défaut) devrait être la cellule A1, donc :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
If Range("A1").End(xlDown).Row = 65536 then
    ' Affiche un message
    MsgBox "Le fichier " & fichier & " ne contient pas de données."
    ' Termine la porcédure
    Exit Sub   ' si c'est bien ce que tu veux...
End If

Si le fichier est trop volumineux pour être contenu dans une feuille Excel, l'erreur produite doit être gérée en invoquant l'objet Error. Consulte l'aide de VBA (ou les tutoriels Développez.com) pour apprivoiser la gestion d'erreurs.

Je quitte. Je dois préparer le dîner (déjeuner en québécois) de mes morphales.