[VBA] Via Macro Excel, Ouvrir & Editer fichier CSV [RÉSOLU]

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : [VBA] Via Macro Excel, Ouvrir & Editer fichier CSV [RÉSOLU]

denis1979

Ce qui est déja en place:
Une base de donnée exporte un fichier CSV contenant les résultats d'une requete SQL.
(pouvant atteindre 30000-40000 entrées)

la requete ne peut malheureusement pas etre modifiée, et cause le problème suivant:
certaines cellules contienent du texte, parmis ce texte, en de rares occasions on peut voir la séquence ";" (guillemets inclus) ... cela cause un changement de cellule (pas trop grave) , suivi d'une ouverture de guillemets (par le 2e guillement de la séquence).
Lorsque arrive la fin de ligne, elle n'est pas considérée , vu que dans une string , et ainsi une ou plusieurs lignes complètes de données sont conservées en tant que texte dans l'une des cellules.

Dans un rapport, le trouble peut survenir approximativement une dizaine de fois en moyenne.
Manuellement, le trouble peut etre solutionné en ouvrant un éditeur texte, faire une recherche pour les lignes problématique, corriger, sauvegarder. À l'ouverture suivante , les données sont complètes et aucune ligne n'est manquante.

J'utilise déja un fichier excel avec macros VBA pour effectuer un formatage et des calculs sur les données une fois qu'elles sont corrigées pour l'analyse et la production de rapports.

Malgé mes recherches, je n'ai toutefois pour l'instant pas trouvé une procédure qui permettrait d'automatiser la correction.
word.application ne semble pas avoir de méthode pour ouvrir un fichier (ou la doc est bien cachée :lol: )

- un fichier ayant un nom connu, dans un répertoire connu. ayant l'extention CSV.
- Ouverture via un editeur texte (pas de préférence, notepad, wordpad, word, dès que ca fonctionne)
- Recherche et remplacement des données
- Sauvegarde du fichier corrigé (soit en CSV, ou en XLS pour importation dans un rapport)
- Fermeture du fichier texte et retour a excel pour la suite des opérations

Message édité par denis1979 le 27-08-2007 à 17:48:48

Publicité

gyllou

as-tu essayé :
Set fs = CreateObject("Scripting.FileSystemObject" )
Ok = fs.FileExists(Nomfichier)
If (Ok) Then
Set f = fs.OpenTextFile(Nomfichier)
Ligne = f.ReadLine
While Not f.AtEndOfStream
Ligne = f.ReadLine
Valeur = Split(Ligne, ";" )
For Col = 0 To 15 Step 1
Cells(Lig, Col) = Valeur(Col)
Next
Wend
f.Close
End If

enfin, a creuser.

Message cité 1 fois
Message édité par gyllou le 24-08-2007 à 20:58:02

denis1979

gyllou a écrit :

hrm...
avec le nom de fichier, ou le chemin de fichier complet , le fichier n'ouvre pas.
de plus si je comprend bien la boucle, tu fais une séparation manuelle des cellules pour chaque ; du fichier..
ce feature est normalement correctement pris en charge par excel.
mon problème ne survient que occasionnellement.

une cellule contenant un commentaire texte dans la base de donnée.
si le commentaire contient <guillemet><point-virgule><guillemet> alors j'ai le problème.

je cherche a faire une équivalence de :
Selection.Replace What:="";"", Replacement:="point-virgule", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

qui fonctionne très bien pour modifier le contenu des cellules.. mais je veux éditer dans un editeur texte avant d'ouvrir via excel.. justement a cause du séparateur.

pour l'ouverture de fichier, je doit avoir raté quelque chose..

kiki29

Difficile sans échantillon de fichier csv, mais à priori en adaptant à ton contexte

Option Explicit

Sub Tst()
Dim Fichier As Variant
ChDir ThisWorkbook.Path
Fichier = Application.GetOpenFilename("Fichier CSV (*.csv), *.csv" )
If Fichier <> False Then Lire Fichier
End Sub

Private Sub Lire(ByVal sNomFichier As String)
Dim Chaine As String
Dim Ar() As String
Dim i As Long
Dim iRow As Long, iCol As Long
Dim NumFichier As Integer
Dim Separateur As String * 1

Separateur = ";"
Cells.Clear
With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Close
NumFichier = FreeFile

iRow = 0
Open sNomFichier For Input As #NumFichier
Do While Not EOF(NumFichier)
iCol = 1 : iRow = iRow + 1
Line Input #NumFichier, Chaine
Ar = Split(Chaine, Separateur)
For i = LBound(Ar) To UBound(Ar)
Cells(iRow, iCol) = Ar(i)
iCol = iCol + 1
Next
Loop
Close #NumFichier

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Message édité par kiki29 le 25-08-2007 à 08:34:16

denis1979

ca me donne quelques pistes a suivre, je retourne plancher la dessus.. en attendant..voici un echantillon partiel d'un fichier csv (non, je n'incluerai pas 40000 lignes hehe)

5915;CANADA;53703;MEME JOUR;ORACLE;2006.09.06;2006.09.12;Oui;1741;660;APPEL TELEPHONIQUE;16;MISE A JOUR PAR L INFORMATIQUE;LE CALCUL DE TAXES SUR LES FACTURES NE CORRESPOND PAS À L ADRESSE DE LIVRAISON. LES TAXES DE L ONTARIO SONT PRIS EN COMPTE ALORS QUE ÇA DEVRAIT ÊTRE CEUX DU QUEBEC. VOIR LES PRINTSCREEN;Hello, We have yet to hear back from you therefore we can only assume that the issue has been resolved. For any further questions or if the issue persists, please don t hesitate to contact IT Helpdesk. Have a nice day, 
5916;CANADA;53704;MEME JOUR;RESEAU;2006.09.06;2006.09.08;Oui;968;953;APPEL TELEPHONIQUE;21;AIDE OFFERTE PAR INFORMATIQUE;CAN NOT CHANGE REGIONAL SETTINGS. SEE PRINT SCREEN FOR ERROR. SHE NEEDS TO CHANGE LIST SEPARATOR FOR ";";Hello, The problem was solved. For any further questions, please don t hesitate to contact IT Helpdesk. Have a nice day, 
5917;CANADA;53705;DEMAIN;CRS;2006.09.06;2006.09.20;Oui;1888;673;INFORMATIQUE;16;MISE A JOUR PAR L INFORMATIQUE;SUR LE SERVEUR CITRIX2, LA CRÉATION DES FICHIERS CRS_ACCOUNT_FILE NE FONCTIONNE PLUS DEPUIS LE 24 AOÛT. LES TASKS SONT TOUJOURS EN MODE "RUNNING" PEUT IMPORTE L HEURE DE LA JOURNÉE, MAIS AUCUN FICHIER N EST CRÉÉ.;
5918;CANADA;53706;URGENT;ORACLE;2006.09.06;2006.09.29;Oui;2004;339;PAR COURRIEL;21;AIDE OFFERTE PAR INFORMATIQUE;DATE: 09/06/2006 04:02 PM SUBJECT: PROBLEM WITH PRODUCT ORDERS EVEN IF A PRODUCT IS SETUP TO BE PURCHASED AND SOLD ONLY BY CASE, SOME ORDERS STILL END UP HAVING UNITS IN THEM. THIS CAUSES INVENTORY PROBLEMS IN THE WAREHOUSE AND THE TRUCKS AS WELL AS GP PROBLEMS. PLEASE REFER TO IMAGES FOR EXAMPLE IN COMPANY <censored> : 18 UNITS OF <censored> ARE ORDERED AND PICKED AS 0.11 CASE UNITS2.GIF. THE PRODUCT SOLD IN AND FORMAT OPTIONS ARE SETUP CORRECTLY.<irrelevant details censored>;Your IT request has been resolved by our team. Please, take a few seconds to fill the survey in order to improve quality of the service. Thank you and have a great day IT Department team
5919;CANADA;53707;URGENT;RESEAU;2006.09.06;2006.09.07;Oui;211;233;APPEL TELEPHONIQUE;16;MISE A JOUR PAR L INFORMATIQUE;ERREUR 412 LORS D UNE TENTATIVE D UNE CONNECTION À VPN;Bonjour, Votre requête informatique a été résolue par notre équipe. S il vous plaît, prenez quelques secondes pour remplir le sondage afin d améliorer la qualité du service. L équipe du Département Informatique

5915 5916 5917 5918 et 5919 sont des numéros de lignes.
lors de l'ouverture "normale" dans excel, la ligne 5917 n'apparait pas.
la raison est situé ici :
TO CHANGE LIST SEPARATOR FOR ";";Hello, The problem was

-------------------------------ici^--------------------------------
le premier point-virgule fait partie du texte, le guillement ouvre ensuite une string, résultat, lorsqu'on arrive a la fin de la ligne, le carriage-return n'est pris en considération que comme partie de la string donc un changement de ligne a l'intérieur d'une cellule, au lieu d'un changement d'entrée de donnée (nouvelle ligne)

résolution manuelle :
click-droit X.CSV
ouvrir avec : Notepad
Edition - Remplacer
rechercher : ";"
remplacer par : SEMI-COLON
remplacer tout

kiki29

A priori mon post plus haut lit correctement ton Csv
Autrement une moulinette pour expurger ton Csv et le sauver

Dans un module Standard

Declare Function GetTickCount Lib "kernel32" () As Long

Dans ThisWorkbook

Option Explicit

Sub ChoixCsv()
Dim Fichier As Variant
ChDir ThisWorkbook.Path
Fichier = Application.GetOpenFilename("Fichier CSV (*.csv), *.csv", , "Sélectionner CSV", , False)
If Fichier <> False Then Moulinette Fichier
End Sub

Private Sub Moulinette(ByVal NomFichier As String)
Dim Chaine As String, sNomFichierCorr As String
Dim Ar() As String, i As Long
Dim Debut As Long, Fin As Long
Dim Cpt As Long, Pos As Integer
Const sSep As String * 1 = ";"
Application.StatusBar = ""
Debut = GetTickCount
Cpt = 0
Close
sNomFichierCorr = ThisWorkbook.Path & Application.PathSeparator & "FichierCorrigé.csv"
Open NomFichier For Input As #1
Open sNomFichierCorr For Output As #2
Do
Line Input #1, Chaine
Cpt = Cpt + 1
Ar = Split(Chaine, sSep)
For i = LBound(Ar) To UBound(Ar)
Ar(i) = Trim(Replace(Ar(i), ";", "" ))
Ar(i) = Trim(Replace(Ar(i), Chr(34), "" ))
' et peut-être même
Ar(i) = Trim(Replace(Ar(i), " ", "" ))
Pos = InStr(Ar(i), " " )
If Pos > 0 Then Ar(i) = RemoveSpc(Ar(i))
Next i
Print #2, Join(Ar, sSep)
Application.StatusBar = Cpt
Loop Until EOF(1)
Close #2
Close #1
Fin = GetTickCount
Application.StatusBar = "Terminé : " & Format((Fin - Debut) / 1000, "0.00" )
End Sub

Private Function RemoveSpc(ByVal s As String) As String
Dim Pos As Integer
s = Trim(s)
Do
Pos = InStr(s, " " )
s = Replace(s, " ", " " )
Loop Until Pos = 0
RemoveSpc = s
End Function

Message édité par kiki29 le 28-08-2007 à 09:13:03

denis1979

merci beaucoup!
ca fonctionne a merveille..

bon ca prend quelques minutes.. mais passer 40 000 lignes a la moulinette ya rien qui sera instantané

encore merci.

Message édité par denis1979 le 27-08-2007 à 17:49:08

kiki29

Plus simple, plus rapide et remplace vraiment ";" par "Semi-Colon"

Option Explicit

Sub ChoixCsv()
Dim Fichier As Variant
ChDir ThisWorkbook.Path
Fichier = Application.GetOpenFilename("Fichier CSV (*.csv), *.csv", , "Sélectionner CSV", , False)
If Fichier <> False Then Moulinette Fichier
End Sub

Private Sub Moulinette(ByVal NomFichier As String)
Dim Chaine As String, sNomFichierCorr As String
Dim Debut As Long, Fin As Long
Dim Cpt As Long
Dim Temps As Double

Application.StatusBar = ""
Debut = GetTickCount
Cpt = 0
Close

sNomFichierCorr = ThisWorkbook.Path & Application.PathSeparator & "FichierCorrigé.csv"
Open NomFichier For Input As #1
Open sNomFichierCorr For Output As #2
Do
Cpt = Cpt + 1
Line Input #1, Chaine

Chaine = Replace(Chaine, Chr(34) & Chr(59) & Chr(34), "Semi-Colon" )
Chaine = Replace(Chaine, " ", "" )
Chaine = Replace(Chaine, "<irrelevant details censored>", "" )
Chaine = Replace(Chaine, "<censored>", "" )
Chaine = RemoveSpc(Chaine)

Print #2, Chaine
Application.StatusBar = Cpt
Loop Until EOF(1)
Close #2
Close #1

Fin = GetTickCount
Temps = (Fin - Debut) / 1000
Application.StatusBar = "Terminé : " & Format(Temps, "0.00" )
End Sub

Private Function RemoveSpc(ByVal s As String) As String
Dim Pos As Integer
s = Trim(s)
Do
Pos = InStr(s, " " )
s = Replace(s, " ", " " )
Loop Until Pos = 0
RemoveSpc = s
End Function

Message édité par kiki29 le 07-09-2007 à 06:35:19

FORUM HardWare.fr

Programmation

VB/VBA/VBS

[VBA] Via Macro Excel, Ouvrir & Editer fichier CSV [RÉSOLU]

Sujets relatifs
selectionner un fichier qui a 15 jours	avec une macro Excel, ouvrir un fichier sous un autre logiciel
NET USE Batch & Tache Planifiée [Résolu]	[ASP.NET][C#][Résolu]données d'un datagridview
[VBA POWERPOINT] Comment tagger une diapo et récupérer le tag en VBA ?	[Résolu] Problème d'arborescence avec require_once( )
recupérer un nombre dans un fichier texte grace a un Bat
Plus de sujets relatifs à : [VBA] Via Macro Excel, Ouvrir & Editer fichier CSV [RÉSOLU]

Page générée en 0.039 secondes