Bonjour à tous,
Je travaille sur un fichier excel et j'essaye de récupérer des informations de fichiers CSV.
Le code ci-dessous fonctionne, mais cela prend un temps énorme, car j'ai plusieurs dizaines de fichiers de 30000 lignes environ..
J'ai donc cherché comment récupérer ces informations sans avoir besoin d'ouvrir les fichiers (c'est ce qui prend beaucoup de temps).
J'ai essayé avec les connexions ADO mais je n'y arrive pas, le fait d'utiliser les fichiers un par un avec la fonction Dir() fait partie des problèmes que je rencontre.
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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98 Sub init() Application.ScreenUpdating = False 'Pour que l'écran ne soit pas mis à jour Dim Fichier As String Dim rep As String Dim n As Long n = 2 Dim dat As String rep = "C:\TEMP\PROD_COMPAR\" Fichier = Dir(rep) Do While Fichier <> "" Set Entree = Workbooks.Open(Filename:="C:\TEMP\PROD_COMPAR\" & Fichier, local:=True) Workbooks("Ecarts MDC_SDC").Sheets(1).Range("B" & n) = nbval(Entree) Workbooks("Ecarts MDC_SDC").Sheets(1).Range("C" & n) = ecartTG(Entree) Workbooks("Ecarts MDC_SDC").Sheets(1).Range("D" & n) = ecartTD(Entree) Workbooks("Ecarts MDC_SDC").Sheets(1).Range("E" & n) = ecartMC(Entree) n = n + 1 Call ThisWorkbook.fermeture_classeur Fichier = Dir() Loop End Sub Function nbval(ByVal Entree As Workbook) As Long Dim i As Long i = 1 While (Not IsEmpty(Entree.Sheets(1).Range("A" & i))) i = i + 1 Wend nbval = i - 2 End Function Function ecartTG(ByVal Entree As Workbook) As Long Dim i As Long i = 1 Dim n As Long n = 0 While (Not IsEmpty(Entree.Sheets(1).Range("A" & i))) If ((Range("J" & i).Value <> Range("K" & i).Value)) Then n = n + 1 End If i = i + 1 Wend ecartTG = n End Function Function ecartTD(ByVal Entree As Workbook) As Long Dim i As Long i = 1 Dim n As Long n = 0 While (Not IsEmpty(Entree.Sheets(1).Range("A" & i))) If (Range("H" & i).Value <> Range("I" & i).Value) Then n = n + 1 End If i = i + 1 Wend ecartTD = n End Function Function ecartMC(ByVal Entree As Workbook) As Long Dim i As Long i = 1 Dim n As Long n = 0 While (Not IsEmpty(Entree.Sheets(1).Range("A" & i))) If (Range("L" & i).Value <> Range("M" & i).Value) Then n = n + 1 End If i = i + 1 Wend ecartMC = n End Function
Merci d'avance pour votre aide
Mathilde
Partager