XL 2013 Macro VBA conversion fichier tsv en csv

dolloe · 31 Juillet 2019

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

Robert · 1 Août 2019

Re,

Ha oui tu as raison !... Je vais regarder ça (c'est bon, j'ai voulu faire la feignasse et j'ai perdu ! )...

dolloe · 1 Août 2019

C'est le propre de l'homme de faire la feignasse

Robert · 1 Août 2019

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

dolloe · 1 Août 2019

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

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 ?

Robert · 1 Août 2019

Re,

Oui tu as tout à fait raison c'est DL02...

dolloe · 1 Août 2019

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 ?

dolloe · 1 Août 2019

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 :

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

Je te tiens au courant.

Robert · 1 Août 2019

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 ?!...

XL 2013 Macro VBA conversion fichier tsv en csv

dolloe

XLDnaute Nouveau

Pièces jointes

Robert

XLDnaute Barbatruc

dolloe

XLDnaute Nouveau

Robert

XLDnaute Barbatruc

dolloe

XLDnaute Nouveau

Robert

XLDnaute Barbatruc

dolloe

XLDnaute Nouveau

dolloe

XLDnaute Nouveau

Robert

XLDnaute Barbatruc

Discussions similaires