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 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173
|
Option Explicit
Dim adresse As String 'Adresse du dossier où sont les fichiers
Dim date_jour As Date 'Date du jour que l'on traite
Dim ligne_courante As Long 'Numéro de la prochaine ligne sur laquelle on peut écrire sur le fichier final
Dim nom_fichier_final As String 'Nom du fichier final
Dim Wk As Workbook 'Objet classeur représentant le fichier final
Dim noms_fichiers(1 To 250) As String 'Tableau où sont indiqués tous les noms des classeurs présents dans le dossier "adresse"
Sub Importation()
'Permet de ne pas afficher les alertes
Application.DisplayAlerts = False
'Récupération des données sur le classeur actuel
adresse = Cells(10, 2).Value 'de la forme C:\Users\
date_jour = Format(Cells(16, 2), "dd/mm/yyyy")
nom_fichier_final = Cells(15, 2).Value
'Initialisation des variables
ligne_courante = 9 '8 lignes d'entête donc prochaine ligne où les données peuvent être écrites est la n°9
'Création des variables limitées à la procédure
Dim Derniere_ligne_fichier_concatene As Long 'Numéro de la dernière ligne du fichier final
Dim j As Integer, i As Integer 'Variables d'itérations
Dim numero_fichier As Integer 'Numéro de fichier dans le dossier (indice du tableau noms_fichiers dans lequel le nom du fichier est indiqué)
numero_fichier = 1
'Récupération de tous les noms de fichiers présents dans le dossier et mémorisation dans le tableau noms_fichiers
noms_fichiers(numero_fichier) = Dir(adresse)
While noms_fichiers(numero_fichier) <> ""
If noms_fichiers(numero_fichier) <> nom_fichier_final & ".*" Then 'Pour éviter de prendre en compte le fichier final comme un fichier à concaténer si le programme a déja été appliqué au dossier
numero_fichier = numero_fichier + 1
noms_fichiers(numero_fichier) = Dir
Else
noms_fichiers(numero_fichier) = Dir
End If
Wend
'Création d 'un classeur, identification avec l'objet Wk et sauvegarde
Set Wk = Workbooks.Add
Wk.SaveAs (adresse & nom_fichier_final)
'Appel de la fonction permettant de remplir le fichier final
For i = 1 To numero_fichier - 1
If i = 1 Then
Call Remplissage_fichier_final(i, True)
Else
Call Remplissage_fichier_final(i, False)
End If
Next i
'Copie dans l'entete du fichier final de la date du jour
Wk.Activate
Cells(2, 3) = date_jour
'Comptage du nombre de ligne du fichier final
Derniere_ligne_fichier_concatene = Application.WorksheetFunction.CountA(Range("A:A")) + 3
'Trie des données par ordre chronologique
Range("A9:J" & Derniere_ligne_fichier_concatene).Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range("A9:A" & Derniere_ligne_fichier_concatene), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveSheet.Sort
.SetRange Range("A8:J" & Derniere_ligne_fichier_concatene)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Suppression des lignes en double
For j = Derniere_ligne_fichier_concatene To 10 Step -1
If CDec(CDate(Cells(j, 1))) = CDec(CDate(Cells(j - 1, 1))) Then
Rows(j).Select
Selection.EntireRow.Delete
End If
Next j
For i = 9 To Derniere_ligne_fichier_concatene
'Reconversion du format de date dans le bon sens...
If Day(Cells(i, 1)) < 13 Then
Cells(i, 1) = Format(Cells(i, 1), "dd/mm/yyyy hh:mm:ss")
End If
Next i
Wk.Save
Wk.Close
'Réactivation des alertes
Application.DisplayAlerts = True
MsgBox ("La concaténation est terminée. Le fichier est dans le dossier renseigné")
End Sub
Sub Remplissage_fichier_final(i As Integer, bool As Boolean)
'Création des variables locales
Dim Derniere_ligne As Integer
Dim l As Integer, j As Integer, k As Integer
'Création d 'un classeur, identification avec le fichier à concaténer
Dim Wk_valeurs As Workbook
Set Wk_valeurs = Workbooks.Open(adresse & noms_fichiers(i))
'Comptage du nombre de ligne du fichier à concatener
Derniere_ligne = Application.WorksheetFunction.CountA(Range("A:A")) + 3
'Copie de l'entête dans le cas où c'est le premier fichier à traiter
If bool = True Then
Wk_valeurs.Activate
Rows("1:8").Select
Selection.Copy
Wk.Activate
Range("A1").Select
ActiveSheet.Paste
End If
'Copie de la prochaine ligne à ajouter dans le fichier final
For l = 9 To Derniere_ligne
Wk_valeurs.Activate
Dim ligne(1 To 10) As Variant
'Problème avec les dates donc obligé de changer le format de la date en fonction du numéro du jour ...
If Day(Cells(l, 1)) < 13 Then
ligne(1) = Format(Cells(l, 1), "mm/dd/yyyy hh:mm:ss")
Else
ligne(1) = Format(Cells(l, 1), "dd/mm/yyyy hh:mm:ss")
End If
For j = 2 To 10
ligne(j) = Cells(l, j)
Next j
'Copie de la ligne dans le fichier final
Wk.Activate
If Int(CDec(CDate(ligne(1)))) = CDec(CDate(date_jour)) Then 'le fichier ne doit contenir que des données du même jour donc suppression de toutes les données concernant un jour different
For k = 1 To 10
Cells(ligne_courante, k) = ligne(k)
Next k
ligne_courante = ligne_courante + 1
End If
Next l
Wk_valeurs.Close
Wk.Activate
Wk.Save
End Sub |
Partager