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 · 31 Juillet 2019

Bonjour Dolloe, bonjour le forum,

Utiliser l'enregistreur de macro est une excellente méthode pour commencer mais on se retrouve avec énormément de code pollué. La règle d'or en VBA c'est d'éviter autant que possible les Select inutiles qui ralentissent l'exécution du code et sont source de plantage. Un simple copier/coller entre deux onglets différents se fait avec la syntaxe Onglet_Source.Plage_source.Copy Onglet_Destination.Range(Cellule_de_Destination). Il faut toujours spécifier le nom des onglets devant la plage. Ton code épuré à vérifier car des fois j'ai eu des doutes...

Code:

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

ActiveSheet.Rows("1:11").Delete Shift:=xlUp
ActiveSheet.Rows(3).Delete Shift:=xlUp
ActiveSheet.Rows("1").Delete Shift:=xlUp
ActiveSheet.Columns(1).Delete Shift:=xlToLeft
ActiveSheet.Range("A1").FormulaR1C1 = "s"
ActiveSheet.Rows(1).Cut Destination:=ActiveSheet.Rows(3)
ActiveSheet.Columns(1).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveSheet.Range("A2").FormulaR1C1 = "Time, CSV"
ActiveSheet.Range("A3").FormulaR1C1 = "s"
ActiveSheet.Range("A4").FormulaR1C1 = "=RC[1]/1000"
ActiveSheet.Columns(2).Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
ActiveSheet.Range("A4").AutoFill Destination:=Range("A4:A1738"), Type:=xlFillDefault
ActiveSheet.Name = "Data"
Sheets.Add After:=ActiveSheet
Sheets("Data").Cells.Copy
Sheets("Feuil1").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Feuil1").Rows(1).Delete Shift:=xlUp
Sheets("Feuil1").Columns(2).Delete Shift:=xlToLeft
Sheets.Add After:=ActiveSheet
Sheets("Feuil1").Rows(1).Copy Sheets("Feuil2").Rows(1)
Application.CutCopyMode = False
Sheets("Feuil2").Range("A2").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])"
Sheets("Feuil2").Range("A2").AutoFill Destination:=Range("A2:A278"), Type:=xlFillDefault
Sheets.Add After:=ActiveSheet
Sheets("Feuil2").Columns("A:BB").Copy
Sheets("Feuil3").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Feuil3").Range("A1").FormulaR1C1 = "Time"
Sheets("Feuil3").Range("A1").Select
End Sub

dolloe · 31 Juillet 2019

Bonjour Robert,

Merci pour ton aide. Effectivement ca réduit bien le code. J'ai testé et ca a l'air de fonctionner.

Maintenant je bloque sur l'étape d'après où je souhaite :
1) Supprimer les onglets "Data" , "Feuille1"; "Feuille"2"..sans demander à l'utilisateur de faire "OK"
2) Dans l'onglet "Feuille 3" remplacer les ", " par des points "." => Cette partie de code ne fonctionne pas
3) Enregistrer le fichier dans le même dossier avec le même nom mais avec l'extension .csv ... le tout sans demander à l'utilisateur de faire "OK" (que ce soit transparent)

VB:

ActiveWindow.ScrollWorkbookTabs Sheets:=-1
    ActiveWindow.ScrollWorkbookTabs Sheets:=-1
    ActiveWindow.ScrollWorkbookTabs Sheets:=-1
    Sheets("Data").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Feuil1").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Feuil2").Select
    ActiveWindow.SelectedSheets.Delete
    Cells.Select
    ActiveWindow.SmallScroll Down:=-24
    Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("F243").Select
    ActiveWindow.SmallScroll Down:=-18
    ActiveWindow.ScrollRow = 203
    ActiveWindow.ScrollRow = 186
    ActiveWindow.ScrollRow = 176
    ActiveWindow.ScrollRow = 166
    ActiveWindow.ScrollRow = 157
    ActiveWindow.ScrollRow = 148
    ActiveWindow.ScrollRow = 139
    ActiveWindow.ScrollRow = 104
    ActiveWindow.ScrollRow = 90
    ActiveWindow.ScrollRow = 81
    ActiveWindow.ScrollRow = 73
    ActiveWindow.ScrollRow = 64
    ActiveWindow.ScrollRow = 47
    ActiveWindow.ScrollRow = 41
    ActiveWindow.ScrollRow = 38
    ActiveWindow.ScrollRow = 34
    ActiveWindow.ScrollRow = 31
    ActiveWindow.ScrollRow = 28
    ActiveWindow.ScrollRow = 25
    ActiveWindow.ScrollRow = 23
    ActiveWindow.ScrollRow = 21
    ActiveWindow.ScrollRow = 19
    ActiveWindow.ScrollRow = 17
    ActiveWindow.ScrollRow = 15
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 7
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 4
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 2
    ActiveWindow.ScrollRow = 1
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\C54473\Documents\Macro tsv\toto.csv", FileFormat:=xlCSV, _
        CreateBackup:=False

Robert · 31 Juillet 2019

Re,

Application.DisplayAlerts permet de masquer (= False) / d'afficher (= True) les messages d'Excel. Il est fortement conseillé de les remettre à True en fin de code pour éviter les déconvenues...
Tu peux aussi supprimer tous les ScrollRow qui sont dus au déplacements...

Le code :

VB:

Application.DisplayAlerts = False
Sheets("Data").Delete
Sheets("Feuil1").Delete
Sheets("Feuil2").Delete
Application.DisplayAlerts = True
Sheets("Feuil3").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

dolloe · 31 Juillet 2019

Merci c'est beaucoup mieux ainsi.
Quelle est la ligne de code pour supprimer les ScrollRow ?

Je vois encore 2 améliorations possibles :

1) Enregistrer le fichier dans le même chemin que le fichier source et avec le même nom sauf l'extension .csv qui changera
2) En fonction des fichiers, je ne "maitrise" pas la taille des lignes . Comment gérer cet aspect ?

Robert · 31 Juillet 2019

Re,

Supprime physiquement toutes les lignes de code où il y a ScrollRow.

Pour le reste, remplace le début du code par :

Code:

Sub test()
Dim CA As String
Dim Nom As String
CA = ActiveWorkbook.Path & "\"
Nom = Split(ActiveWorkbook.Name,".")(0)
With Application.FileDialog(msoFileDialogFilePicker)
    .InitialFileName = CA
    '... la suite du code

et la fin par :

Code:

'... le code au dessus
Sheets("Feuil3").Cells.Replace What:=",", Replacement:=".", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
ActiveWorkbook.SaveAs Filename:=CA & Nom & ".csv", FileFormat:=xlCSV, CreateBackup:=False

dolloe · 31 Juillet 2019

Ah d'accord j'avais peur que ca plante le code...

Ca marche presque ta solution sauf que ..En fait j'ai implémenté la macro dans un fichier Excel "import_tsv" avec un bouton qui lance cette macro. Du coup le fichier final porte le nom de import_tsv.csv et non pas le nom le nom de départ.csv

Robert · 31 Juillet 2019

Re,

Si ce que tu appelles départ est le fichier que tu ouvres en début de macro alors le début du code devient :

VB:

Sub test()
Dim CS As Workbook
Dim CA As String
Dim Nom As String

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
CA = CS.Path & "\"
Nom=Split(CS.Name,".")(0)

la fin reste inchangée...

dolloe · 31 Juillet 2019

Oui c'est exactement ce que je sous-entendais par là.

Je t'embête encore...

VB:

ActiveSheet.Range("A4").AutoFill Destination:=Range("A4:A1738"), Type:=xlFillDefault

Pour cette partie je souhaiterais faire la même opération mais pas jusqu'à une cellule fixe (ici choisi arbitrairement à 1738 ) mais tant que la cellule B n'est pas vide. J'ai essayé d'utiliser la formule SI(ESTVIDE;..) de Excel, mais ca marche pas vraiment. Aurais tu une idée ?

Robert · 31 Juillet 2019

Re,

VB:

ActiveSheet.Range("A4").AutoFill Destination:=Range("A4:A" & Activesheet.Cells(Application.Rows.Count, "B").End(xlUp).Row), Type:=xlFillDefault

dolloe · 1 Août 2019

Parfait j'ai appliqué le même code sur la ligne où je concatène les données

VB:

Sheets("Feuil2").Range("A2").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])"
Sheets("Feuil2").Range("A2").AutoFill Destination:=Range("A2:A" & Sheets("Feuil1").Cells(Application.Rows.Count, "B").End(xlUp).Row), Type:=xlFillDefault

Ce qui me manque encore c'est au lieu de lister les Feuil1!RC de 1 à 9 ca serait de concatener Feuil1!RC(i) tant que la colonne (i) n'est pas vide. J'imagine q'il va falloir faire une boucle while ? ...Tu vois comment faire simplement ?

Robert · 1 Août 2019

Re,

Désolé mais je ne comprends pas. D'abord, je suis nul en formules. Si tu m'expliques pas à pas ce que tu veux faire je pourrais peut-être trouver une solution VBA...

dolloe · 1 Août 2019

Pas de soucis, je vais essayer de t'expliquer.

Dans mon fichier source d'origine, j'ai des données sur un certain nombre de lignes (variables selon le fichier) et un certain nombre de colonnes (variables selon le fichier). Ci joint un exemple

Dans mon traitement je souhaite concaténer, c'est à dire avoir une cellule contenant tous les données de le même ligne séparés par une virgule. Pour ce faire j'utilisais sur Excel la fonction CONCATENER .Voilà ce que je souhaite obtenir pour la première ligne:

Dans cet exemple je dois donc concatener les données A2,B2,C2,D2,E2,F2,G2,H2,I2,J2,K2...mais je dois pas continuer en L2 ni en M2 etc car la cellule est vide.
Dans mon fichier je ne maitrise pas la taille des lignes (variable). La fonction doit donc s'arrêter dès qu'elle détecte que la cellule est vide.

J'espère avoir été assez claire, sinon n'hésite pas à me le signaler. J'essaierai d'expliquer ca différemment.

Merci d'avance en tout cas.

Robert · 1 Août 2019

Re,

Ok j'ai compris.
Une solution de feignasse : laisse comme ça puisque concaténer des cellules vides ne change rien. À mon avis (non testé), ça ira plus vite avec l'AutoFill derrière que de faire une boucle et d'ajuster la formule à chaque ligne.

dolloe · 1 Août 2019

En fait ca me gêne après car les données vides sont espacées de virgules et je me retrouve avec ces virgules qui polluent mes données.
Le AutoFill je le mets après la formule ?

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

Robert

XLDnaute Barbatruc

dolloe

XLDnaute Nouveau

Robert

XLDnaute Barbatruc

dolloe

XLDnaute Nouveau

Robert

XLDnaute Barbatruc

dolloe

XLDnaute Nouveau

Robert

XLDnaute Barbatruc

dolloe

XLDnaute Nouveau

Discussions similaires