VBA convertir csv en xls - Perte de 0

Version imprimable

Voir 40 message(s) de cette discussion en une page

11/12/2017, 12h37
unparia

Bonjour à tous
Ces "videos" sont plus embarrassantes qu'autre chose et donnent plus le tournis que quoi que ce soit d'autre
Alors qu'il suffit de :

Citation:

En attendant le fichier source de Marion, poste donc ton code, je verrais bien si t'as oublié un paramétrage

Bien moins "gourmand" et tellement plus "parlant" pour ceux qui savent lire un code :coucou:
11/12/2017, 13h16
Marc-L

Laisse tomber, de toute manière c'est simple : renommer le csv en .txt puis l'ouvrir
et bien répondre à l'Assistant d'importation, juste définir la colonne en question en texte et c'est torché.

Et c'est aussi valable pour toi Marion !

L'Enregistreur de macro délivrant une base de code sur un plateau ou encore juste en lisant l'aide de la méthode OpenText …

la seule facon ou j'ai le resultat attendu est celle la
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Sub importcsv() ' recupe le texte complet avec input simple Dim x As Integer: x = FreeFile Dim lines As String fichier = "C:\Users\polux\Desktop\test.csv" Open fichier For Input As #x lines = Input$(LOF(x), #x) Close #x Debug.Print lines tabl = Split(lines, vbCrLf) With ActiveSheet .Range("A1").Resize(UBound(tabl) + 1, 1) = Application.Transpose(tabl) Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _ :=Array(Array(1, 2), Array(2, 2), Array(3, 2)), TrailingMinusNumbers:=True End With End Sub
le seul soucis pour moi est cette ligne
Code:

1 2 FieldInfo _ :=Array(Array(1, 2), Array(2, 2), Array(3, 2)))
sans cette ligne les zeros dans les colonnes B et plus ne sont pas gardés
mais comment le paramétrer ???!!!!!

ensuite
si j'utilise opentext et texttocolumns ca fonctionne mais des que j'injecte le tableau obtenu dans le classeur de la macro ca remet tout sans zero meme en ayant mis nunberformat="@" avant

11/12/2017, 13h30
Marc-L

• Juste via un Copier / Coller entre les deux feuilles !

• Sinon avant d'injecter il suffit de paramétrer le format de la colonne dans la feuille de destination !

• Pour importer directement dans la feuille au lieu d'OpenText c'est QueryTables et là aussi en manuel
via A partir d'un fichier texte du menu Données il suffit de bien paramétrer l'importation !
En dehors de l'aide VBA interne de QueryTable, voir aussi sa propriété TextFileColumnDataTypes …

j'avais deja essayé query Marcl mais pas modifier ce parmetre en enregistrant la macro
ou ca se trouve dans l'interfazce cette modif quand on le fait a la main ???

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub qquery()
    ' pas bon seul la cellule A1 est bonne
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\polux\Desktop\test.csv", Destination:=Range("$A$1"))
        .Name = "test"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 2, 2)
        .TextFileTrailingMinusNumbers = False
        .Refresh BackgroundQuery:=False
    End With
End Sub

11/12/2017, 15h58
Marc-L

Que ce soit à l'ouverture (OpenText), à la conversion (TextToColumns) ou à l'importation des données (QueryTable)
c'est toujours au même endroit de l'Assistant dans l'étape 3 avec la possibilité de sélectionner le format par colonne.
Comme déjà signalé, s'il y a avait eu un souci avec ces fonctions de base d'Excel si vitales pour importer des données …

Par contre dans ton code il n'y a vraiment rien qui te choque ? 8O PreserveFormatting ! :ptdr:
Donc ligne à supprimer …

T'as pas dû aller dans certaines options lors de l'utilisation de l'Enregistreur de macro.
Je vérifie toujours chaque ligne générée, l'erreur est humaine et parfois certaines de ces lignes sont inutiles.

Edit : pourtant avec le paramétrage de ta ligne RefreshStyle cela n'aurait pas dû te gêner, je viens de tester …

Bonjour.
Peut-etre comme ceci.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Sub marion05()
   ReDim arr(Columns.Count)
   For i = LBound(arr) To UBound(arr)
      arr(i) = 2 'Texte
   Next
 
   Set dest = Feuil5
   dest.Activate
   ActiveSheet.Cells.Clear
 
   chemin = "C:\Users\Admin\Documents\marion05.txt"
 
   Connection = "TEXT;" & chemin
 
   With ActiveSheet.QueryTables.Add(Connection:= _
        Connection, Destination:=Range("$A$1"))
 
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = arr
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Voir 40 message(s) de cette discussion en une page