Forum |  HardWare.fr | News | Articles | PC | Prix | S'identifier | S'inscrire | Shop Recherche
1901 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

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

 



 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

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

n°1603768
denis1979
Posté le 24-08-2007 à 17:36:28  profilanswer
 

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
mood
Publicité
Posté le 24-08-2007 à 17:36:28  profilanswer
 

n°1603805
gyllou
Posté le 24-08-2007 à 20:57:14  profilanswer
 

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
n°1603821
denis1979
Posté le 24-08-2007 à 21:45:19  profilanswer
 

gyllou a écrit :

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.


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

n°1603906
kiki29
Posté le 25-08-2007 à 08:10:37  profilanswer
 

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
n°1604436
denis1979
Posté le 27-08-2007 à 14:33:03  profilanswer
 

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,<br><br>  We have yet to hear back from you therefore we can only assume that the issue has been resolved.<br> For any further questions or if the issue persists, please don t hesitate to contact IT Helpdesk.<br><br>  Have a nice day,<br>
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,<br><br>  The problem was solved.<br> For any further questions, please don t hesitate to contact IT Helpdesk.<br><br>  Have a nice day,<br>
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.<br><br>  <br> Please, take a few seconds to fill the survey in order to improve quality of the service.<br><br>  Thank you and have a great day<br><br>  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,<br><br>  Votre requête informatique a été résolue par notre équipe.<br><br>  <br> S il vous plaît, prenez quelques secondes pour remplir le sondage afin d améliorer la qualité du service.<br><br>  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,<br><br>  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

n°1604650
kiki29
Posté le 27-08-2007 à 17:26:08  profilanswer
 

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), "<br>", "" ))
                    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
n°1604672
denis1979
Posté le 27-08-2007 à 17:48:09  profilanswer
 

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
n°1604686
kiki29
Posté le 27-08-2007 à 18:04:30  profilanswer
 

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, "<br>", "" )
                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

Aller à :
Ajouter une réponse
  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 joursavec 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]


Copyright © 1997-2018 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR