Ecrire dans un fichier .csv ou .txt à partir d'excel

**Beamish** · 28/02/2007, 14h26

Bonjour à tous,

j'ai un petit problème liée à la limitation à 65xxxx lignes d'excel.

Je m'explique, j'ai un petit prog en vba excel qui me permet d'importer et de réorganiser des données (d'un autre fichier) sous excel.
Mon problème est donc que le fichier originel est censé contenir juste 1 commune hors chez moi il contient près d'1 département (plus de 300 communes !!) d'ou le probleme de limitation d'excel.

donc je souhaiterais ajouter une ligne de code permettant non plus de renseigner directement excel mais un fichier txt ou csv.

l'intérêt étant de conserver le programme tout en ne limitant pas le nombre d'enregistrement à ajouter

Merci beaucoup pour le coup de main !

**helios77** · 28/02/2007, 14h33

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
'déclaration du fichier
dim fic as string
fic = "C:\Test.txt"
 
'ouverture du fichier
open fic for output as 1
 
'ecirutre dans le fichier
print #1, données à écrire
 
'Fermeture du fichier
close #1
 
End sub

**ouskel'n'or** · 28/02/2007, 14h40

Donc tu as des données dans une feuille Excel et tu souhaites les exporter dans un csv
Combien de colonnes as-tu ? Si tu en as plusieurs, quel séparateur veux-tu
Je te passe un code qui te permet de séparer les données d'une ligne Excel comportant plusieurs colonnes par un séparateur ";" et donc ton fichier sera aussi bien un txt qu'un csv

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub FichierTxt()
Dim i, j, DernièreLigne, DernièreColonne, f as worksheet
Set f = ActiveSheet
    DerniereLigne = f.Range("A1").SpecialCells(xlCellTypeLastCell).Row
    DerniereColonne = f.Range("A1").SpecialCells(xlCellTypeLastCell).Column
    Open "D:\txt\LeFichier.csv" For Output As #1
    For i = 1 To DerniereLigne
        For j = 1 To DerniereColonne - 1
            Print #1, f.Cells(i, j).Formula + ";"; 
            'pour séparateur ";" tu remplaces si ton séparateur est une virgule
        Next j
        Print #1, f.Cells(i, j + 1).Formula
    Next i
    Close #1
End Sub

A+

**Beamish** · 28/02/2007, 14h47

voici mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
Sub importFANTOIR()
 
Set Monclasseur = ThisWorkbook
Monclasseur.Activate
 
' Import du fichier FANTOIR
 
ChDir "H:\temp" ' Emplacement du fichier source
ChDrive "H:"
monfichier = Application.GetOpenFilename
If monfichier <> False Then
    rep = MsgBox("Ouvrir : " & monfichier, vbOKCancel)
End If
If rep = 1 Then
' recompose le nom à l'envers pour détecter le premier \
   toto = Len(Trim(monfichier))
   montest = ""
   titi = Trim(monfichier)
   Do
   titi = Right(titi, 1)
       If titi = "\" Then
        ' recompose le mot à l'endroit
         toto = Len(montest)
         titi = montest
         Do
           titi = Right(titi, 1)
           p = p + 1
           Monfic = Monfic + titi
           titi = Mid(montest, 1, toto - p)
           If p = i Then Exit Do
         Loop
         Exit Do
        Else
           i = i + 1
           montest = montest + titi
           titi = Mid(Trim(monfichier), 1, toto - i)
       End If
    Loop
 
If UCase(Left(Monfic, 4)) = "FANR" Then
 
Application.Cursor = xlWait
Application.DisplayStatusBar = True
Application.StatusBar = "Import du fichier Identifiant du Local en cours ..."
 
Application.ScreenUpdating = False
 
Dim maligne As String
' longueur  de l'enregistrement total
Dim mazone(150) As String
 
' Ouvre le fichier en lecture.
Open monfichier For Input As #1
Direction = False
 
' Liste des rues
Sheets("Fantoir").Select
Range("A2:AZ60000").Clear
Set MaParcelle = Range("A2")
 
Do While Not EOF(1)
    ' Ne lit que les chaînes de caractères ne retourne pas
    ' les codes CHr(13)
    Input #1, maligne '
 
 
' En tête commun à tous les articles
 
mazone(1) = Mid(Trim(maligne), 1, 2) 'ccodep
mazone(2) = Mid(Trim(maligne), 3, 1) 'ccodir
mazone(3) = Mid(Trim(maligne), 4, 3)  'ccocom
 
'If mazone(3) = "066" Then 'Selectionne la communne (66 = CHATELLERAULT)
 
If Len(Trim(Mid(Trim(maligne), 74, 1))) = 0 Then 'supprime les entités annulées "O" et "Q" en (74,1)
 
mazone(4) = "'" + Mid(Trim(maligne), 7, 4) 'ccoriv (Impose une zone texte)
mazone(5) = Mid(Trim(maligne), 11, 1) 'cleriv
mazone(6) = Mid(Trim(maligne), 12, 4) 'natvoi
mazone(7) = Mid(Trim(maligne), 16, 26) 'libvoi
mazone(8) = Mid(Trim(maligne), 42, 1) 'filler
mazone(9) = Mid(Trim(maligne), 43, 1) 'typcom
mazone(10) = Mid(Trim(maligne), 44, 2) 'filler
mazone(11) = Mid(Trim(maligne), 46, 1) 'ruractu
mazone(12) = Mid(Trim(maligne), 47, 2) 'filler
mazone(13) = Mid(Trim(maligne), 49, 1) 'carvoi
mazone(14) = Mid(Trim(maligne), 50, 1) 'indpop
mazone(15) = Mid(Trim(maligne), 51, 2) 'filler
mazone(16) = Mid(Trim(maligne), 53, 7) 'popreel
mazone(17) = Mid(Trim(maligne), 60, 7) 'poppart
mazone(18) = Mid(Trim(maligne), 67, 7) 'popfict
mazone(19) = Mid(Trim(maligne), 74, 1) 'annul
mazone(20) = Mid(Trim(maligne), 75, 4) 'janannul
mazone(21) = Mid(Trim(maligne), 82, 4) 'jancrea
mazone(22) = Mid(Trim(maligne), 89, 15) 'filler
mazone(23) = Mid(Trim(maligne), 104, 5) 'ccovoi
mazone(24) = Mid(Trim(maligne), 109, 1) 'indclvoi
mazone(25) = Mid(Trim(maligne), 110, 1) 'indldnb
mazone(26) = Mid(Trim(maligne), 111, 2) 'filler
mazone(27) = Mid(Trim(maligne), 113, 8) 'motclass (permet de restituer l'ordre alphabétique)
mazone(28) = Mid(Trim(maligne), 121, 30) 'filler
 
 
Monclasseur.Sheets("Fantoir").Select
MaParcelle.Select
 
 
 For i = 1 To 28
       Selection.Offset(0, i - 1).Formula = mazone(i)
 Next
 
Set MaParcelle = MaParcelle.Offset(1, 0)
 
End If
 
'End If
 
Loop
Close #1    ' Ferme le fichier.' fin d'import
 
MsgBox "L'import est terminé !"
 
Call Majecran
 
Else
    rep = MsgBox("Le fichier d'import doit être FANR.* !", vbCritical)
    rep = MsgBox("L'import est annulé !", vbCritical)
End If
 
Else
     rep = MsgBox("L'import est annulé !", vbCritical)
End If
Call Majecran
End Sub
 
Sub Majecran()
Application.ScreenUpdating = True
Application.StatusBar = False
Application.DisplayStatusBar = True
'redonne la main à Excel sur la barre des tâches
Application.Cursor = xlDefault
End Sub

j'ai du mal a identifier l'endroit ou inserer ce code...

**Beamish** · 28/02/2007, 14h49

Envoyé par ouskel'n'or

Donc tu as des données dans une feuille Excel et tu souhaites les exporter dans un csv

en fait non les données sont issues d'un autre fichier.
en fait excel ne serait utilisé que comme une sorte de fichier temporaire (sans atteindre les 65000 données) avant l'export

**ouskel'n'or** · 28/02/2007, 15h01

Tu ne lis donc pas toutes les lignes
Tu as deux solutions, une avec ton tableau (puisqu'il est fait) et une sans
Mais avant, trois questions
- tu veux bien placer tes 28 données concernant "une parcelle" sur une même ligne ?
- Tu sembles renseigner une feuille de calculs, non ?
- Si oui, que mets-tu dedans ?
A+

**Beamish** · 28/02/2007, 15h30

Envoyé par ouskel'n'or

- tu veux bien placer tes 28 données concernant "une parcelle" sur une même ligne ?

oui

Envoyé par ouskel'n'or

- Tu sembles renseigner une feuille de calculs, non ?

en effet le fichier excel est "préparé" avec les intitulé des colonnes

Envoyé par ouskel'n'or

- Si oui, que mets-tu dedans ?

les données du fichier FANTOIR qui sont en l'état difficilement exploitable

**ouskel'n'or** · 28/02/2007, 15h45

Et cette feuille, après traitement, tu peux bien la relire, non ? Ce ne sont pas les bonnes données que tu places dedans ?
Après je te réponds

**Beamish** · 28/02/2007, 15h59

en effet ce sont bien les bonnes données....
les données initiales du fichier fantoir sont en fait mise "bout à bout" sans séparateur et donc à moins de connaitre précisément la description des champs et de leur longueur, elles sont difficilement exploitables, enfin pour moi en tout cas.

**ouskel'n'or** · 28/02/2007, 16h04

Bon, alors le code que je t'ai donné fonctionne. sans utiliser le tableau.
Si tu veux quand même l'utiliser, alors, après tes lignes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
     Endif
Loop

bref, à la fin de ta boucle, tu peux faire :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
    Open "D:\txt\LeFichier.csv" For Output As #1
    For i = 1 To 27
        Print #1, mazone(i) + ";";
            'pour avoir "," comme séparateur tu remplaces ";" par ","
    Next i
    'i passe à 28
    Print #1, mazone(i) 'dernière donnée de la ligne
    Close #1

Ceci dit, tu peux imbriquer la lecture et l'écriture en ouvrant les deux fichiers à la fois
A+

**Beamish** · 28/02/2007, 16h43

excuse moi de ma réponse naïve mais c'est bien ici que j'insere le code ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
     Set MaParcelle = MaParcelle.Offset(1, 0)
 
End If
 
End If
 
Loop
'code a inserer
Close #1    ' Ferme le fichier.' fin d'import
 
MsgBox "L'import est terminé !"

ci c'est bien cela alors les données sont bien dans le fichier excel mais dans le csv seul les ";" sont insérés...

**ouskel'n'or** · 28/02/2007, 17h10

C'est bien ça.
Là ton tableau est renseigné, et tu renseignes le txt mais pour une ligne seulement, cette ligne comportant 28 données.
C'est bien ce que tu veux ?

**Beamish** · 28/02/2007, 17h25

en fait c'est bien plus d'une ligne que je souhaite insérer mais tout le fichier originel (cf. un extrait en pj - supprimer l'extension .txt pour avoir l'extension réelle)

**ouskel'n'or** · 28/02/2007, 17h42

Autant pour moi, j'avais oublié.
Okay, on repart du début

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
43
44
45
46
47
48
49
50
51
52
53
54
Open monfichier For Input As #1
Open "D:\txt\LeFichier.csv" For Output As #2
Do While Not EOF(1)
    ' Ne lit que les chaînes de caractères ne retourne pas
    ' les codes CHr(13)
    Input #1, maligne '
' En tête commun à tous les articles
 
    mazone(1) = Mid(Trim(maligne), 1, 2) 'ccodep
    mazone(2) = Mid(Trim(maligne), 3, 1) 'ccodir
    mazone(3) = Mid(Trim(maligne), 4, 3)  'ccocom
 
'If mazone(3) = "066" Then 'Selectionne la communne (66 = CHATELLERAULT)
 
    If Len(Trim(Mid(Trim(maligne), 74, 1))) = 0 Then 'supprime les entités annulées "O" et "Q" en (74,1)
 
        mazone(4) = "'" + Mid(Trim(maligne), 7, 4) 'ccoriv (Impose une zone texte)
        mazone(5) = Mid(Trim(maligne), 11, 1) 'cleriv
        mazone(6) = Mid(Trim(maligne), 12, 4) 'natvoi
        mazone(7) = Mid(Trim(maligne), 16, 26) 'libvoi
        mazone(8) = Mid(Trim(maligne), 42, 1) 'filler
        mazone(9) = Mid(Trim(maligne), 43, 1) 'typcom
        mazone(10) = Mid(Trim(maligne), 44, 2) 'filler
        mazone(11) = Mid(Trim(maligne), 46, 1) 'ruractu
        mazone(12) = Mid(Trim(maligne), 47, 2) 'filler
        mazone(13) = Mid(Trim(maligne), 49, 1) 'carvoi
        mazone(14) = Mid(Trim(maligne), 50, 1) 'indpop
        mazone(15) = Mid(Trim(maligne), 51, 2) 'filler
        mazone(16) = Mid(Trim(maligne), 53, 7) 'popreel
        mazone(17) = Mid(Trim(maligne), 60, 7) 'poppart
        mazone(18) = Mid(Trim(maligne), 67, 7) 'popfict
        mazone(19) = Mid(Trim(maligne), 74, 1) 'annul
        mazone(20) = Mid(Trim(maligne), 75, 4) 'janannul
        mazone(21) = Mid(Trim(maligne), 82, 4) 'jancrea
        mazone(22) = Mid(Trim(maligne), 89, 15) 'filler
        mazone(23) = Mid(Trim(maligne), 104, 5) 'ccovoi
        mazone(24) = Mid(Trim(maligne), 109, 1) 'indclvoi
        mazone(25) = Mid(Trim(maligne), 110, 1) 'indldnb
        mazone(26) = Mid(Trim(maligne), 111, 2) 'filler
        mazone(27) = Mid(Trim(maligne), 113, 8) 'motclass (permet de restituer l'ordre alphabétique)
        mazone(28) = Mid(Trim(maligne), 121, 30) 'filler
 
        For i = 1 To 27
            Print #1, mazone(i) + ";";
            'pour avoir "," comme séparateur tu remplaces ";" par ","
        Next i
        'i passe à 28
        Print #1, mazone(i) 'dernière donnée de la ligne
        Redim Mazone(28) 
        'pour nettoyer le tableau (tu testes en mettant 1 point d'arret sur loop...
 
Loop
Close #1    ' Ferme le fichier.' fin d'import
Close #2

Tu dis

**Beamish** · 28/02/2007, 17h53

Envoyé par ouskel'n'or

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
        Redim Mazone(28)

Tu dis

tableau déjà dimensionné...

**Beamish** · 28/02/2007, 17h57

voici le fichier excel, modifier l'extension txt en xls

**ouskel'n'or** · 28/02/2007, 17h57

Ok ! Je n'ai pas testé. Dommage car si jamais tu as une ligne incomplète (?) ton tableau conserve la valeur de la ligne précédente
Si c'est las (possibilité de ligne incomplète) tu dis, on arrangera ça
Là, tu supprimes la ligne.

A+

**Beamish** · 28/02/2007, 18h06

c'est sur mais normalement (le peu que j'ai compris du fichier source) toutes les lignes sont renseignées...

**ouskel'n'or** · 28/02/2007, 18h16

Il ne te reste plus qu'à tester

Tiens-nous au courant
A+

**Beamish** · 02/03/2007, 11h34

je l'ai testé il me renvoit l'erreur suivante et renseigne une seule ligne sur le fichier xls et aucune sur le csv :
- Mode d'acces au fichier incorrect en pointant sur :
Print #1, mazone(i) 'dernière donnée de la ligne

Ecrire dans un fichier .csv ou .txt à partir d'excel

Macros et VBA Excel

Discussions similaires

Partager

Partager