XL 2013 Macro VBA conversion fichier tsv en csv

D

dolloe

XLDnaute Nouveau
Bonjour,

Je vous contacte au sujet d'une macro qui devrait me permettre de convertir des fichiers tsv au format csv selon un formalisme donné afin d'utiliser ce fichier avec un logiciel spécifique.
J'ai longuement parcouru le forum sans trouver toujours ce que je souhaitais.
Pour plus de clareté, je vous joins en PJ le fichier brut en toto.tsv et le fichier final attendu en toto.csv (oui toto c'est très original).
Je précise que la colonne "Time" est à créer à partir de "Relative Time"/1000.

J'ai commencé à faire quelque chose, mais je bloque. Je précise que je débute complètement, et que la macro a été réalisé à l'aide de l'enregistreur :

Merci pour votre aide.

VB: 
Sub test()
With Application.FileDialog(msoFileDialogFilePicker)
    .InitialFileName = ActiveWorkbook.Path & "\"
    .Filters.Clear
    .Filters.Add "enregistrements", "*.tsv"
    .Show
    If .SelectedItems.Count > 0 Then
        Workbooks.OpenText Filename:=.SelectedItems(1), Origin:=932, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
         xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
         Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
         Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
         Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1)), _
         TrailingMinusNumbers:=True
    End If
End With

Rows("1:11").Select
    Range("A11").Activate
    Selection.Delete Shift:=xlUp
    Rows("3:3").Select
    Selection.Delete Shift:=xlUp
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Range("B1:J1").Select
    
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "s"
    Rows("1:1").Select
    Selection.Cut Destination:=Rows("3:3")
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "Time, CSV"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "s"
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "=RC[1]/1000"
    Columns("B:B").Select
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("A4").Select
    Selection.AutoFill Destination:=Range("A4:A1738"), Type:=xlFillDefault
    Range("A4:A1738").Select
    ActiveWindow.ScrollRow = 1723
    ActiveWindow.ScrollRow = 1699
    ActiveWindow.ScrollRow = 1664
    ActiveWindow.ScrollRow = 1546
    ActiveWindow.ScrollRow = 1456
    ActiveWindow.ScrollRow = 1326
    ActiveWindow.ScrollRow = 1217
    ActiveWindow.ScrollRow = 726
    ActiveWindow.ScrollRow = 628
    ActiveWindow.ScrollRow = 530
    ActiveWindow.ScrollRow = 448
    ActiveWindow.ScrollRow = 354
    ActiveWindow.ScrollRow = 52
    ActiveWindow.ScrollRow = 1
    
    ActiveSheet.Name = "Data"
    
         Range("E10").Select
    Sheets.Add After:=ActiveSheet
    Sheets("Data").Select
    Rows("2:2").Select
    Selection.Copy
    Sheets("Feuil1").Select
    Rows("1:1").Select
    Sheets("Data").Select
    Application.CutCopyMode = False
    Cells.Select
    Range("A2").Activate
    Selection.Copy
    Sheets("Feuil1").Select
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Range("F19").Select
    
     Sheets.Add After:=ActiveSheet
    Sheets("Feuil1").Select
    Rows("1:1").Select
    Selection.Copy
    Sheets("Feuil2").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    Sheets("Feuil1").Select
    Range("A6").Select
    Application.CutCopyMode = False
    Cells.Select
    Range("A6").Activate
       Sheets("Feuil2").Select
    Range("A2").Select
    ActiveCell.FormulaR1C1 = _
        "=CONCATENATE(Feuil1!RC,"";"",Feuil1!RC[1],"";"",Feuil1!RC[2],"";"",Feuil1!RC[3],"";"",Feuil1!RC[4],"";"",Feuil1!RC[5],"";"",Feuil1!RC[6],"";"",Feuil1!RC[7],"";"",Feuil1!RC[8],"";"",Feuil1!RC[9])"
    Range("A2").Select
    Selection.AutoFill Destination:=Range("A2:A278"), Type:=xlFillDefault
    Range("A2:A278").Select
    ActiveWindow.ScrollRow = 258
    ActiveWindow.ScrollRow = 254
    ActiveWindow.ScrollRow = 245
    ActiveWindow.ScrollRow = 235
    ActiveWindow.ScrollRow = 207
    ActiveWindow.ScrollRow = 183
    ActiveWindow.ScrollRow = 158
    ActiveWindow.ScrollRow = 134
    ActiveWindow.ScrollRow = 116
    ActiveWindow.ScrollRow = 82
    ActiveWindow.ScrollRow = 69
    ActiveWindow.ScrollRow = 59
    ActiveWindow.ScrollRow = 51
    ActiveWindow.ScrollRow = 42
    ActiveWindow.ScrollRow = 25
    ActiveWindow.ScrollRow = 18
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 1
    Sheets.Add After:=ActiveSheet

    Sheets("Feuil2").Select
    Columns("A:BB").Select
    ActiveWindow.ScrollColumn = 42
    ActiveWindow.ScrollColumn = 40
    ActiveWindow.ScrollColumn = 38
    ActiveWindow.ScrollColumn = 33
    ActiveWindow.ScrollColumn = 28
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 1
    Selection.Copy
    Sheets("Feuil3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Time"
    Range("F9").Select
  
End Sub
 

Pièces jointes

  • Macro tsv.zip
    462 KB · Affichages: 14
Trier par date Trier par votes
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re,

J'ai repris tous le code en utilisant des variables pour les onglets et fait un boucle pour la concaténation. Regarde ci ça fonctionne :
VB: 
Sub test()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim Nom As String 'déclare la variable Nom
Dim OD As Worksheet 'déclare la variable OD (Onglet Data)
Dim O1 As Worksheet 'déclare la variable O1 (Onglet Feuil1)
Dim O2 As Worksheet 'déclare la variable O2 (Onglet Feuil2)
Dim O3 As Worksheet 'déclare la variable O3 (Onglet Feuil3)
Dim DLO2 As Integer 'déclare la variable DLO2 (Derlière Ligne de l'onglet O2)
Dim DC As Integer 'déclare la variable DC (Dernière Colonne)
Dim VC As String 'déclare la variable VC (Valeur Concaténée)

With Application.FileDialog(msoFileDialogFilePicker)
    .InitialFileName = ActiveWorkbook.Path & "\"
    .Filters.Clear
    .Filters.Add "enregistrements", "*.tsv"
    .Show
    If .SelectedItems.Count > 0 Then
        Workbooks.OpenText Filename:=.SelectedItems(1), Origin:=932, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
         xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
         Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
         Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
         Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1)), _
         TrailingMinusNumbers:=True
    End If
End With
Set CS = ActiveWorkbook 'définit le classeur source CS
CA = CS.Path & "\" 'définit le chemin d'accès
Nom = Split(CS.Name, ".")(0) 'définit le nom (nom du fichier sans l'extension)
Set OD = ActiveSheet 'définit l'onglet OD
OD.Name = "Data" 'renomme l'onglet
OD.Rows("1:11").Delete Shift:=xlUp
OD.Rows(3).Delete Shift:=xlUp
OD.Rows("1").Delete Shift:=xlUp
OD.Columns(1).Delete Shift:=xlToLeft
OD.Range("A1").FormulaR1C1 = "s"
OD.Rows(1).Cut Destination:=ActiveSheet.Rows(3)
OD.Columns(1).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
OD.Range("A2").FormulaR1C1 = "Time, CSV"
OD.Range("A3").FormulaR1C1 = "s"
OD.Range("A4").FormulaR1C1 = "=RC[1]/1000"
OD.Columns(2).Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
OD.Range("A4").AutoFill Destination:=OD(Range("A4:A" & OD.Cells(Application.Rows.Count, "B")).End(xlUp).Row), Type:=xlFillDefault
Sheets.Add After:=ActiveSheet 'ajoute un nouvel onglet vierge en dernière position
Set O1 = ActiveSheet 'définit l'onglet O1
Sheets("Data").Cells.Copy
O1.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False
O1.Rows(1).Delete Shift:=xlUp
O1.Columns(2).Delete Shift:=xlToLeft
Sheets.Add After:=ActiveSheet 'ajoute un nouvel onglet vierge en dernière position
Set O2 = ActiveSheet 'définit l'onglet O2
O1.Rows(1).Copy O2.Rows(1)
Application.CutCopyMode = False
DLO2 = O2.Cells(Application.Rows.Count, "A").End(xlUp).Row 'dernière ligne éditée de la colonne A de l'onglet O2
For I = 2 To DL 'boucle 1 : sur toutes les lignes I de 2 a DL
    DC = O1.Cells(I, Application.Columns.Count).End(xlToLeft).Column 'définit la dernière colonne éditée DC de la ligne I de l'onglet O1
    For J = 1 To DC 'boucle sur toutes les colonnes CD de 1 à DC
        VC = IIf(VC = "", O1.Cells(I, J), VC & ";" & O1.Cells(I, J)) 'définit la variable VC (Valeur Concaténée)
    Next J 'prochaine colonne de la boucle
    O2.Cells(I, "A") = VC 'renvoie la valeur VC dans la cellule ligne I, colonne "A"
Next I 'prochaine ligne de la boucle 1
Sheets.Add After:=ActiveSheet 'ajoute un nouvel onglet vierge en dernière position
Set O3 = ActiveSheet 'définit l'onglet O3
O2.Columns("A:BB").Copy
O3.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False
Application.DisplayAlerts = False
Sheets("Data").Delete
O1.Delete
O2.Delete
Application.DisplayAlerts = True
O3.Cells.Replace What:=",", Replacement:=".", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
ActiveWorkbook.SaveAs Filename:="C:\Users\C54473\Documents\Macro tsv\toto.csv", FileFormat:=xlCSV, CreateBackup:=False
O3.Range("A1").FormulaR1C1 = "Time"
O3.Range("A1").Select
End Sub
 
Vote positif 0 Vote négatif
D

dolloe

XLDnaute Nouveau
J'ai testé et ca coince à un endroit. Erreur d'execution "1004" :
Capture.JPG


J'ai remplacer le OD(Range) par OD.Range. Le code se lance au moins.

Par contre la boucle ne fonctionne pas super bien, ca fait pas encore ce que je souhaite. J'essaie de déquortiquer..

Qu'est -ce que la variable DL dans la boucle ? Ne serait-ce pas DL 02 ?
 
Vote positif 0 Vote négatif
D

dolloe

XLDnaute Nouveau
La boucle ne donne rien.
J'ai remplacé pour essayé DL02, là ca fait quelque chose. Par contre ca concatène les données de l'onglet Feuille 2 alors que je souhaiterais que ce soit celle de l'onglet Feuile 1 (01).
Du coup ca expliquerait que DL02 soit nul.
J'ai essayé de rajouter un Se01 activesheet mais ca ne marche pas. Tu verrais d'ou vient le problème ?
 
Vote positif 0 Vote négatif
D

dolloe

XLDnaute Nouveau
J'ai fait une modif rapide du code en renommant la feuil1 en test
VB: 
For i = 2 To DLO2 'boucle 1 : sur toutes les lignes I de 2 a DL
    DC = Sheets("test").Cells(i, Application.Columns.Count).End(xlToLeft).Column 'définit la dernière colonne éditée DC de la ligne I de l'onglet O1
    For j = 1 To DC 'boucle sur toutes les colonnes CD de 1 à DC
        VC = IIf(VC = "", Sheets("test").Cells(i, j), VC & ";" & Sheets("test").Cells(i, j)) 'définit la variable VC (Valeur Concaténée)
    Next j 'prochaine colonne de la boucle
   
    O2.Cells(i, "A") = VC 'renvoie la valeur VC dans la cellule ligne I, colonne "A"
Next i 'prochaine ligne de la boucle 1

Ca me donne quelque chose de pas mal sauf...que ca mouline à fond et que ca recopie toujours la valeur précédente :

Capture.JPG


EDIT : j'ai rajouté à la fin de la boucle un VC=0 et ca a l'air de fonctionner.

Je te tiens au courant.
 
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re,

C'est sûr que ça va mouliner grave !....
Mais je ne comprends pas. Regarde le bout de code on va le décortiquer :
VB: 
For I = 2 To DL 'boucle 1 : sur toutes les lignes I de 2 a DL
    DC = O1.Cells(I, Application.Columns.Count).End(xlToLeft).Column 'définit la dernière colonne éditée DC de la ligne I de l'onglet O1
    For J = 1 To DC 'boucle sur toutes les colonnes CD de 1 à DC
        VC = IIf(VC = "", O1.Cells(I, J), VC & ";" & O1.Cells(I, J)) 'définit la variable VC (Valeur Concaténée)
    Next J 'prochaine colonne de la boucle
    O2.Cells(I, "A") = VC 'renvoie la valeur VC dans la cellule ligne I, colonne "A"
Next I 'prochaine ligne de la boucle 1

- il boucle sur touts les lignes I de 2 à DL
- il récupère la dernière colonne DC de la même ligne I mais de l'onglet O1
- il boucle sur les colonnes 1 à DC et concatène dans VC les valeurs de l'onglet O1
- il renvoie dans la colonne A de l ligne I de l'onglet O2 la valeur VC des cellules concaténées
Je ne vois pas pourquoi le fait de renommer l'onglet test devrait faire fonctionner le code mieux que O1 ?!...
 
Vote positif 0 Vote négatif

Discussions similaires

F
  • Résolu(e)
XL 2021 Créer Macro permettant d'indexer des nouveaux clients ? [Résolu]
4 5 6
Réponses
82
Affichages
3 K
fanou06
F
ph.vanne
  • Question
Autres fenêtre "Publication"
Réponses
10
Affichages
427
ph.vanne
ph.vanne
G
  • Question
XL 2019 Sélectionner un fichier pour mettre à jour une base de données
Réponses
3
Affichages
173
sylvanu
sylvanu
L
  • Question
XL 2016 Macro et suppressions de lignes
Réponses
9
Affichages
801
fanfan38
fanfan38
K
  • Question
Microsoft 365 vba :Vlookup + incrémentation d'une plage de donnée
Réponses
1
Affichages
136
vgendron
vgendron
J
  • Question
Microsoft 365 Mini macro en VBA
Réponses
1
Affichages
143
jderoque
J
micie1509
  • Résolu(e)
XL 2021 Exécuter une macro sur plusieurs feuilles
Réponses
9
Affichages
304
micie1509
micie1509
B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
537
Compte Supprimé 979
C
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
AtTheOne
M
  • Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
351
marie3107
M

Membres actuellement en ligne

22 membres et 221 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 103
Messages
2 116 249
Membres
112 696
dernier inscrit
MagideDupont