VBA - Question tri de données
Bonjour à tous,
Je sollicite votre aide car j'ai besoin de trier des données. Je dispose d'environ une centaines de fichiers Excel (chaque fichier est enregistré sous la forme d'une date par exemple "20220401") qui contiennent les mêmes données dans la 1ere colonne (exemple des prénoms), cependant elles ne sont pas toujours dans le même ordre. Dans deux autres colonnes je dispose de 2 données différentes (exemple vitesse et accélération). Il y a un fichier Excel pour chaque jour. Chaque jour, les prénoms sont les mêmes (pas dans le même ordre) et chaque jour les 2 colonnes (vitesse et accélération) prennent des valeurs différentes. Les colonnes vitesse et accélération correspondent au prénom en question.
J'aimerais pouvoir :
-répertorier dans un seul fichier, pour chaque prénom, la vitesse et l'accélération correspondante pour chaque jour, depuis la première date (le premier fichier) jusqu'à la dernière date (le dernier fichier).
PS : Il y'a d'autres valeurs dans d'autres colonnes mais elles ne sont pas à prendre en compte. De plus, ces fichiers sont générés chaque jour. Chaque jour il y a un nouveau fichier avec la date du jour, les prénoms (pas toujours dans le même ordre) et les colonnes vitesse et accélération.
Merci par avance pour votre aide,
En espérant avoir été clair.
Bonjour,
Pouvez vous fournir un exemple des fichiers de "bases" avec seulement quelque lignes.
Et un fichier exemple du résultat attendu une fois la compilation effectuer.
Les fichiers de bases sont t'ils tous dans le meme dossier ?
Merci
Voici un fichier sur un seul jour. Le but est de compiler les lignes de la colonne "C" en rouge avec les lignes deux colonnes jaunes "P" et "Q" pour tous les jours. Donc ceci, avec tous les autres fichiers (autres jours) du même type.
Pour obtenir un fichier de la sorte, avec chaque ligne en rouge, qui apparaît maintenant en colonne. Dans un seul fichier.
Oui les fichiers de base sont tous dans le même dossier.
Merci !
Bonjour
voici une solution possible :
dans ton fichier cible, tu te positionnes comme cela :
[Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row = 1 And Target.Column = 10 Then
Dim strRepertoire As String
Dim iFichier As Long
Dim strfichier As String
Dim strRecupData As String
Dim iPrenom As String
Dim iColVitesse As Long
Dim iColAcc As Long
Dim iLigPrenom As Long
Dim ws As Workbook
' on positionne les variables
strRepertoire = "répertoire des fichiers à compiler\"
iFichier = 2
Set ws = ActiveWorkbook
strfichier = ws.Sheets("Feuil1").Cells(2, iFichier).Value
strRecupData = ws.Sheets("Feuil1").Cells(1, iFichier).Value
' tant qu'on a des noms de fichiers
While strfichier <> ""
' et qu'il faut récupérer les données (pour éviter de recharger des données)
If strRecupData = "oui" Then
'on ouvre le fichier
Workbooks.Open Filename:=strRepertoire & strfichier
iPrenom = 4
iColVitesse = Application.Match("Vitesse", Workbooks(strfichier).ActiveSheet.Rows(1), 0)
iColAcc = Application.Match("Accélération", Workbooks(strfichier).ActiveSheet.Rows(1), 0)
'on récupère les données
While ws.Sheets("Feuil1").Cells(iPrenom, 1).Value <> ""
If Not IsError(Application.Match(ws.Sheets("Feuil1").Cells(iPrenom, 1).Value, Workbooks(strfichier).ActiveSheet.Columns(1), 0)) Then
iLigPrenom = Application.Match(ws.Sheets("Feuil1").Cells(iPrenom, 1).Value, Workbooks(strfichier).ActiveSheet.Columns(1), 0)
ws.Sheets("Feuil1").Cells(iPrenom, iFichier).Value = Workbooks(strfichier).ActiveSheet.Cells(iLigPrenom, iColVitesse).Value
ws.Sheets("Feuil1").Cells(iPrenom, iFichier + 1).Value = Workbooks(strfichier).ActiveSheet.Cells(iLigPrenom, iColAcc).Value
End If
iPrenom = iPrenom + 1
Wend
ws.Sheets("Feuil1").Cells(1, iFichier).Value = "non"
' on ferme le fichier
Workbooks(strfichier).Close
End If
' on passe au fichier suivant
iFichier = iFichier + 2
strfichier = ws.Sheets("Feuil1").Cells(2, iFichier).Value
strRecupData = ws.Sheets("Feuil1").Cells(1, iFichier).Value
Wend
ActiveSheet.Cells(2, 10).Select
End If
End Sub
]
Merci bob pour cette réponse rapide !
Je dois saisir ces données dans une nouvelle feuille d'un fichier Excel vierge ?
Je suis désolé je débute complètement j'ai un peu de mal avec tout ça
Merci
Bob,
J'ai saisi ceci, dans un fichier Excel tout neuf que j'ai nommé "Fichier", avec une seule feuille que j'ai nommée "SACCR_SR". Pour se faire, j'ai saisi ce qui suit dans un Module. Est-ce la bonne manière de procéder ? Comment je lance le code par la suite ?
Merci,
[Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row = 1 And Target.Column = 10 Then
Dim strRepertoire As String
Dim iFichier As Long
Dim strfichier As String
Dim strRecupData As String
Dim iSCOPE_REFERENCE As String
Dim iColRC As Long
Dim iColPFE As Long
Dim iLigSCOPE8REFERENCE As Long
Dim ws As Workbook
' on positionne les variables
strRepertoire = "S:\Risque de credit\Commun\01. Organisation\06. Equipe\Thomas\Evolution SA CCR 01.04 à 30.06\"
iFichier = 2
Set ws = ActiveWorkbook
strfichier = ws.Sheets("SACCR_SR").Cells(2, iFichier).Value
strRecupData = ws.Sheets("SACCR_SR").Cells(1, iFichier).Value
' tant qu'on a des noms de fichiers
While strfichier <> ""
' et qu'il faut récupérer les données (pour éviter de recharger des données)
If strRecupData = "oui" Then
'on ouvre le fichier
Workbooks.Open Filename:=strRepertoire & strfichier
iPrenom = 4
iColRC = Application.Match("Vitesse", Workbooks(strfichier).ActiveSheet.Rows(1), 0)
iColPFE = Application.Match("Accélération", Workbooks(strfichier).ActiveSheet.Rows(1), 0)
'on récupère les données
While ws.Sheets("SACCR_SR").Cells(iSCOPE_REFERENCE, 1).Value <> ""
If Not IsError(Application.Match(ws.Sheets("SACCR_SR").Cells(iSCOPE_REFERENCE, 1).Value, Workbooks(strfichier).ActiveSheet.Columns(1), 0)) Then
iLigSCOPE_REFERENCE = Application.Match(ws.Sheets("SACCR_SR").Cells(iSCOPE_REFERENCE, 1).Value, Workbooks(strfichier).ActiveSheet.Columns(1), 0)
ws.Sheets("SACCR_SR").Cells(iSCOPE_REFERENCE, iFichier).Value = Workbooks(strfichier).ActiveSheet.Cells(iLigSCOPE_REFERENCE, iColRC).Value
ws.Sheets("SACCR_SR").Cells(iSCOPE_REFERENCE, iFichier + 1).Value = Workbooks(strfichier).ActiveSheet.Cells(iLigSCOPE_REFERENCE, iColPFE).Value
End If
iSCOPE8REFERENCE = iSCOPE_REFERENCE + 1
Wend
ws.Sheets("SACCR_SR").Cells(1, iFichier).Value = "non"
' on ferme le fichier
Workbooks(strfichier).Close
End If
' on passe au fichier suivant
iFichier = iFichier + 2
strfichier = ws.Sheets("Feuil1").Cells(2, iFichier).Value
strRecupData = ws.Sheets("Feuil1").Cells(1, iFichier).Value
Wend
ActiveSheet.Cells(2, 10).Select
End If
End Sub
]
Ok j'ai enlevé les [ ] en début et fin, et enregistré le code dans le répertoire de ma feuille de calcul. Ensuite...?