Découper fichier XLS en plusieurs fichiers selon critére
Déclare
Dim i as longDéclare
Dim i as long
Merci Steelson ma correction est faite sur la variable "%" qui est maintenant en "&"
Quand ma colonne n'est pas une date l'enregistrement des fichiers subit quand même un renommage par date si la colonne contient que des chiffres
une idée pour qu'il prennent en compte le format date "yyyy-mm-dd" uniquement quand c'est une date ?
wb.SaveAs (MonRepertoire & "\" & racine & "_" & Format(cle1, "yyyy-mm-dd") & ".csv"), FileFormat:=xlCSV, local:=True
Quand ma colonne n'est pas une date l'enregistrement des fichiers subit quand même un renommage par date si la colonne contient que des chiffres
Excel ne fait pas la différence être nombre et dates puisque une date est enregistré dans excel comme étant un nombre !
Il faudrait que tu mettes un indicateur quelque part ou que tu retiennes 2 versions du fichier.
J'ai de beaucoup simplifié le code depuis ...
https://www.excel-pratique.com/fr/telechargements/utilitaires/dispatcher-compiler-excel-no466
Pour le csv, je regarde.
@Steelson outil vraiment très puissant par contre la compilation de plusieurs fichiers CSV génèrent ce genre de problème
Il vaut mieux adapter ceci pour les fichiers csv : https://forum.excel-pratique.com/viewtopic.php?p=872000#p872000
Il faut bien régler le séparateur du fichier csv : est-ce une tabulation, une virgule ou un point virgule ?
A mettre dans la macro.
Si plusieurs fichiers ont des séparateurs différents, il vaut mieux faire des regroupement séparés et ensuite consolider.
Si tu as un exemple avec 2 fichiers, je suis preneur de regarder ...
Merci pour ton retour les fichiers seront exclusivement en point virgule ";"
l'ajustement doit avoir lieu à quel niveau ?
je prépare deux fichiers immédiatement
J'ai répondu un peu vite ... il vaut mieux utiliser un autre programme proposé ci-dessus ... https://forum.excel-pratique.com/viewtopic.php?p=872000#p872000 à adapter car dans cet exemple il y avait un problème de conversion d'heure.
Il vaut mieux adapter ceci pour les fichiers csv : https://forum.excel-pratique.com/viewtopic.php?p=872000#p872000
Il faut bien régler le séparateur du fichier csv : est-ce une tabulation, une virgule ou un point virgule ?
A mettre dans la macro.
Si plusieurs fichiers ont des séparateurs différents, il vaut mieux faire des regroupement séparés et ensuite consolider.
Si tu as un exemple avec 2 fichiers, je suis preneur de regarder ...
voici deux fichiers
edit : mince je viens de voir ton message
ok, je regarde asap
Pour découper ? tu veux découper en csv ?
Pour recompiler ...
Sub importCSV()
Dim Chemin, Rep As FileDialog, fichier$, T() As String, D, debut As Integer
Set Rep = Application.FileDialog(msoFileDialogFolderPicker)
Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire des fichiers ..."
Rep.Show
If Rep.SelectedItems.Count = 0 Then Exit Sub
Chemin = Rep.SelectedItems(1) & "\"
raz
Range("A2").Select
debut = 2
fichier = Dir(Chemin & "*.csv")
Do While fichier <> ""
Open Chemin & fichier For Input As #1
ligne = 1
Do While Not EOF(1)
Line Input #1, ContenuLigne
T = Split(ContenuLigne, ";")
nItems = UBound(T) + 1
If ligne >= debut Then
If ligne = debut Then ReDim D(1 To nItems, 1 To 1)
If ligne > debut Then ReDim Preserve D(1 To nItems, 1 To ligne - debut + 1) ' Preserve ne permet de redimensionner que la dernière dimension d'un tableau avec conservation des données
For i = 0 To UBound(T)
D(i + 1, ligne - debut + 1) = T(i)
Next i
End If
ligne = ligne + 1
Loop
Close #1
D = Application.Transpose(D)
If ligne - debut = 1 Then
Selection.Resize(1, UBound(D)) = D
Else
Selection.Resize(UBound(D), UBound(D, 2)) = D
End If
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
fichier = Dir
Loop
End Sub
Sub raz()
Range("A1").CurrentRegion.Offset(1, 0).Clear
End Subencore perfectible, je regarderai demain pour inclure automatiquement l'en-tête !
Pour découper ? tu veux découper en csv ?
Pour recompiler ...
Sub importCSV() Dim Chemin, Rep As FileDialog, fichier$, T() As String, D, debut As Integer Set Rep = Application.FileDialog(msoFileDialogFolderPicker) Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire des fichiers ..." Rep.Show If Rep.SelectedItems.Count = 0 Then Exit Sub Chemin = Rep.SelectedItems(1) & "\" raz Range("A2").Select debut = 2 fichier = Dir(Chemin & "*.csv") Do While fichier <> "" Open Chemin & fichier For Input As #1 ligne = 1 Do While Not EOF(1) Line Input #1, ContenuLigne T = Split(ContenuLigne, ";") nItems = UBound(T) + 1 If ligne >= debut Then If ligne = debut Then ReDim D(1 To nItems, 1 To 1) If ligne > debut Then ReDim Preserve D(1 To nItems, 1 To ligne - debut + 1) ' Preserve ne permet de redimensionner que la dernière dimension d'un tableau avec conservation des données For i = 0 To UBound(T) D(i + 1, ligne - debut + 1) = T(i) Next i End If ligne = ligne + 1 Loop Close #1 D = Application.Transpose(D) If ligne - debut = 1 Then Selection.Resize(1, UBound(D)) = D Else Selection.Resize(UBound(D), UBound(D, 2)) = D End If Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select fichier = Dir Loop End Sub Sub raz() Range("A1").CurrentRegion.Offset(1, 0).Clear End Subencore perfectible, je regarderai demain pour inclure automatiquement l'en-tête !
Merci c'est déjà pas mal
Oui découpage si possible en csv
au sujet de la compilation si j'ai 5 fichiers pour un total de 200 000 Lignes cela freeze pas mal il faut peut être que j'essaye avec une bécane beaucoup plus puissante peut être
Pourtant, 200.000 lignes ! Il te faut quand même une bonne RAM. Combien de temps cela a mis ?au sujet de la compilation si j'ai 5 fichiers pour un total de 200 000 Lignes cela freeze pas mal il faut peut être que j'essaye avec une bécane beaucoup plus puissante peut être
Je viens de faire 691 000 lignes sur un serveur de 256 GB de ram sans aucun problème
découpage sous 371 fichiers
ensuite compilation des 371 fichiers pour mon test
Sauf…. des nombres stockés sous forme de date
Pour info j'ai pris un peu les réponses que tu as mis en place pour @joyce au niveau des dates est-ce la cause ?
Pour les dates, excel fait ce qu'il veut ! Quand le jour est inférieur ou égal à 12 il le prend comme le mois (notation US). Sinon il conserve la donnée sous forme de texte en respectant la notation la séquence jour/mois/année.
Ah si tout le monde avait adoptée une suite plus intéressante qui est année-mois-jour !
Il y a 2 façons de faire : soit reconstruire un date avec par exemple
CDbl(DateSerial("20" & Mid(CStr(Tableau(i)), 7, 2), Mid(CStr(Tableau(i)), 4, 2), Mid(CStr(Tableau(i)), 1, 2)))soit inverser mois et jour
Mid(T(i), 4, 2) & "/" & Mid(T(i), 1, 2) & "/" & Mid(T(i), 7, 10). Je ne sais pas s'il y a une autre méthode, je me pose encore la question, cf réponse de Chris ici https://forum.excel-pratique.com/viewtopic.php?p=872136#p872136
Pour les nombres stockés sous forme de texte, il s'agit très souvent du signe des valeurs décimales : point ou virgule. Il faut alors parfois changer l'un en l'autre globalement un fois les valeurs chargées.
Oui découpage si possible en csv
Dans ce cas, la réponse est donnée ici :
https://forum.excel-pratique.com/viewtopic.php?p=870827#p870827
Voici sous forme d'une sub ...encore perfectible, je regarderai demain pour inclure automatiquement l'en-tête !
Option Explicit
Sub importer()
Dim chemin$, Rep As FileDialog
' choix du répertoire
Set Rep = Application.FileDialog(msoFileDialogFolderPicker)
Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire des fichiers ..."
Rep.Show
If Rep.SelectedItems.Count = 0 Then Exit Sub
chemin = Rep.SelectedItems(1) & "\"
' effacement et préparation
Cells.Clear
Range("A1").Select
' chemin, separateur (; par défaut), debut (1 par défaut), entetes (True par défaut)
importCSV chemin
End Sub
Sub importCSV(chemin As String, Optional sep As String = ";", Optional debut As Integer = 1, Optional entetes As Boolean = True)
' sep est le séparateur , ou ; ou vbTab
' debut caractérise la première ligne du fichier csv à importer
' entetes indique s'il faut importer les en-têtes se trouvant sur la ligne début
Dim fichier$, T() As String, D, ligne&, i%, ContenuLigne$, nItems%
fichier = Dir(chemin & "*.csv")
Do While fichier <> ""
Open chemin & fichier For Input As #1
ligne = 1
Do While Not EOF(1)
Line Input #1, ContenuLigne
T = Split(ContenuLigne, sep)
nItems = UBound(T) + 1
If ligne >= debut Then
If ligne = debut Then ReDim D(1 To nItems, 1 To 1)
If ligne > debut Then ReDim Preserve D(1 To nItems, 1 To ligne - debut + 1) ' Preserve ne permet de redimensionner que la dernière dimension d'un tableau avec conservation des données
For i = 0 To UBound(T)
' si date : effectuer permutation jour et mois
D(i + 1, ligne - debut + 1) = T(i)
Next i
End If
ligne = ligne + 1
Loop
Close #1
D = Application.Transpose(D)
If ligne - debut = 1 Then
Selection.Resize(1, UBound(D)) = D ' cas d'une seule ligne dans le fichier csv
Else
Selection.Resize(UBound(D), UBound(D, 2)) = D
End If
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
fichier = Dir
If entetes Then entetes = False: debut = debut + 1 ' on passe l'en-tête pour les fichiers suivants
Loop
End SubPour les dates et les nombres, voir remarques ci-dessus
[/code]
Pour les dates et les nombres, voir remarques ci-dessus
[/quote]
Merci à toi le code est beaucoup plus fluide et le résultat est nickel
Au sujet des nombres il me suffit de convertir une fois le fichier global acquis rien de bien méchant
Pour ma part c'est un "problème" résolu
Voici sous forme d'une sub ...encore perfectible, je regarderai demain pour inclure automatiquement l'en-tête !
Option Explicit Sub importer() Dim chemin$, Rep As FileDialog ' choix du répertoire Set Rep = Application.FileDialog(msoFileDialogFolderPicker) Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire des fichiers ..." Rep.Show If Rep.SelectedItems.Count = 0 Then Exit Sub chemin = Rep.SelectedItems(1) & "\" ' effacement et préparation Cells.Clear Range("A1").Select ' chemin, separateur (; par défaut), debut (1 par défaut), entetes (True par défaut) importCSV chemin End Sub Sub importCSV(chemin As String, Optional sep As String = ";", Optional debut As Integer = 1, Optional entetes As Boolean = True) ' sep est le séparateur , ou ; ou vbTab ' debut caractérise la première ligne du fichier csv à importer ' entetes indique s'il faut importer les en-têtes se trouvant sur la ligne début Dim fichier$, T() As String, D, ligne&, i%, ContenuLigne$, nItems% fichier = Dir(chemin & "*.csv") Do While fichier <> "" Open chemin & fichier For Input As #1 ligne = 1 Do While Not EOF(1) Line Input #1, ContenuLigne T = Split(ContenuLigne, sep) nItems = UBound(T) + 1 If ligne >= debut Then If ligne = debut Then ReDim D(1 To nItems, 1 To 1) If ligne > debut Then ReDim Preserve D(1 To nItems, 1 To ligne - debut + 1) ' Preserve ne permet de redimensionner que la dernière dimension d'un tableau avec conservation des données For i = 0 To UBound(T) ' si date : effectuer permutation jour et mois D(i + 1, ligne - debut + 1) = T(i) Next i End If ligne = ligne + 1 Loop Close #1 D = Application.Transpose(D) If ligne - debut = 1 Then Selection.Resize(1, UBound(D)) = D ' cas d'une seule ligne dans le fichier csv Else Selection.Resize(UBound(D), UBound(D, 2)) = D End If Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select fichier = Dir If entetes Then entetes = False: debut = debut + 1 ' on passe l'en-tête pour les fichiers suivants Loop End SubPour les dates et les nombres, voir remarques ci-dessus
Bonjour à tous
contente de voir des membres ayant une problématique proche de la mienne
j'ai une question pour Steelson
j'utilise ton outil avec succès il m'aide énormément pour compiler mes fichiers.
une fois que j'ai un fichier global j'effectue des corrections
mais ensuite je souhaite décompiler l'ensemble et si possible avec le même nombre de fichier
Ma question est de savoir si il est possible d'inclure au moment de la compilation le nom des fichiers dans une colonne en dernière colonne si possible cela me permet dans un premier temps de savoir à quel fichier appartient une ligne et ensuite à pouvoir dispatcher plus facilement
Merci pour ton aide