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

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Exploiter Données fichiers csv sur excel

 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

Exploiter Données fichiers csv sur excel

n°1634006
Ricardo69
Posté le 30-10-2007 à 17:40:53  profilanswer
 

Bonjour,
 
Je dois réaliser un programme en VBA sur excel me permettant de charger plusieurs fichiers csv (qui contiennent chacun des données différentes) et les mettre en mémoire dans mon fichier Excel afin d'utiliser ces données.
Etant débutant dans la programmation en VBA sur Excel, je suis seulement arrivé a selectionner mes fichiers csv (Avec la fonction Application.GetOpenFilename("Fichier CSV (*.csv),*.csv" ) )
 
Je ne connait pas le code VBA pour mémoriser les données de ces fichiers après les avoir sélectionnés et je ne sais pas non plus comment utiliser seulement certaines données de chaque fichier..
 
Si quelqu'un connait la solution, merci de poster une reponse.
Merci d'avance

mood
Publicité
Posté le 30-10-2007 à 17:40:53  profilanswer
 

n°1634009
devil_k
Posté le 30-10-2007 à 17:52:41  profilanswer
 

Là, tu ne les mémorises pas, si tu avais lu l'aide, tu noteras que application.getopenfilename te renvoie seulement le chemin vers le fichier
du coup, tu affectes cette valeur à une variable, ensuite, si ta variable est différente de fausse, tu la donne en paramètre de workbooks.open
 
Par contre, Excel gère assez mal les CSV, il les met directement en forme à l'ouverture... Du coup, quand tu as des formats à respecter, c'est plutôt gênant vu qu'il te "casse" tout dès l'ouverture

n°1634012
AprilThe5t​h
Posté le 30-10-2007 à 17:56:41  profilanswer
 

Ce code met a jour un fichier Excel avec un fichier csv :
 
 
Sub CorrespTitres()
 
Set TSMBk = Workbooks.Open(Filename:="C:\Medialand\baseAscii\titres_ojd.csv" )
Set TSMSht = TSMBk.Worksheets(1)
Set CouplBk = Workbooks.Open(Filename:="C:\Medialand\baseAscii\support_bdd.csv" )
Set CouplSht = CouplBk.Worksheets(1)
 
'Suppression des Espaces dans Fichier Correspondance
NbLineCorresp = CorrespSht.Cells(65536, 1).End(xlUp).Row
For A = 2 To NbLineCorresp
For B = 1 To 5
    CorrespSht.Cells(A, B) = Trim(CorrespSht.Cells(A, B))
Next B
Next A
 
'Tri Fichier Correspondance
CorrespSht.Cells.Sort Key1:=CorrespSht.Cells(1, 1), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
 
'A/ SUPPORT_BDD.CSV
 
'Transformation CSV >> XLS
'1/ Rétablissement des Virgules
With CouplSht
    NbLineCoupl = .Cells(65536, 2).End(xlUp).Row
    If NbLineCoupl > 1 Then
        For A = 1 To NbLineCoupl
            If .Cells(A, 256).End(xlToLeft).Column > 1 Then
                For B = 2 To .Cells(A, 256).End(xlToLeft).Column
                    .Cells(A, 1) = .Cells(A, 1) & "," & .Cells(A, B)
                Next B
            End If
        Next A
        Range(.Cells(1, 2), .Cells(NbLineCoupl, 256)).Clear
    End If
     
    '2/ Séparation des champs
    Application.DisplayAlerts = False
     
    .Columns(1).TextToColumns Destination:=Range("A1" ), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=True, 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), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
    (20, 1), Array(21, 1), Array(22, 1), Array(23, 1)), TrailingMinusNumbers:=True
     
    Application.DisplayAlerts = True
     
    'MAJ Fichier Correspondance
    NbLineCoupl = .Cells(65536, 1).End(xlUp).Row
    NbLineCorresp = CorrespSht.Cells(65536, 1).End(xlUp).Row
    For A = 1 To NbLineCoupl
     
        'Cas Code TSM Numérique
        If IsNumeric(.Cells(A, 3)) Then
         
            'Cas Code TSM Présent dans Fichier Correspondance
            If Not IsError(Application.Match(.Cells(A, 3), Range(CorrespSht.Cells(2, 2), CorrespSht.Cells(NbLineCorresp, 2)), 0)) Then
                B = Range(CorrespSht.Cells(1, 2), CorrespSht.Cells(NbLineCorresp, 2)).Find(what:=Trim(.Cells(A, 3)), lookat:=xlWhole).Row
                CorrespSht.Cells(B, 1) = Trim(.Cells(A, 1))
                 
            'Code TSM Absent
            Else
                CorrespSht.Cells(NbLineCorresp + 1, 2) = Trim(.Cells(A, 3))
                CorrespSht.Cells(NbLineCorresp + 1, 1) = Trim(.Cells(A, 1))
                NbLineCorresp = NbLineCorresp + 1
            End If
         
        'Autres Cas
        Else
            If Not IsError(Application.Match(Trim(.Cells(A, 3)), Range(CorrespSht.Cells(2, 2), CorrespSht.Cells(NbLineCorresp, 2)), 0)) Then
                B = Range(CorrespSht.Cells(1, 2), CorrespSht.Cells(NbLineCorresp, 2)).Find(what:=Trim(.Cells(A, 3)), lookat:=xlWhole).Row
                CorrespSht.Cells(B, 1) = Trim(.Cells(A, 1))
            Else
                CorrespSht.Cells(NbLineCorresp + 1, 2) = Trim(.Cells(A, 3))
                CorrespSht.Cells(NbLineCorresp + 1, 1) = Trim(.Cells(A, 1))
                NbLineCorresp = NbLineCorresp + 1
            End If
        End If
    Next A
End With
 
'B/ TITRE_OJD.CSV
 
'Transformation CSV >> XLS
'1/ Rétablissement des Virgules
With TSMSht
    NblineTSM = .Cells(65536, 1).End(xlUp).Row
    If .Cells(65536, 2).End(xlUp).Row > 1 Then
        For A = 2 To NblineTSM
            If .Cells(A, 256).End(xlToLeft).Column > 1 Then
                For B = 2 To .Cells(A, 256).End(xlToLeft).Column
                    .Cells(A, 1) = .Cells(A, 1) & "," & .Cells(A, B)
                Next B
            End If
        Next A
        Range(.Cells(1, 2), .Cells(NblineTSM, 256)).Clear
    End If
     
    '2/ Séparation des Champs
    Application.DisplayAlerts = False
     
    .Columns(1).TextToColumns Destination:=Range("A1" ), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=True, 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)), TrailingMinusNumbers:=True
     
    Application.DisplayAlerts = True
     
    'MAJ Fichier Correspondance
    For A = 1 To NblineTSM
        If IsNumeric(.Cells(A, 2)) Then
             If Not IsError(Application.Match(.Cells(A, 2), Range(CorrespSht.Cells(2, 2), CorrespSht.Cells(NbLineCorresp, 2)), 0)) Then
                B = Range(CorrespSht.Cells(1, 2), CorrespSht.Cells(NbLineCorresp, 2)).Find(what:=Trim(.Cells(A, 2)), lookat:=xlWhole).Row
                CorrespSht.Cells(B, 1) = Trim(.Cells(A, 1))
            Else
                CorrespSht.Cells(NbLineCorresp + 1, 2) = Trim(.Cells(A, 2))
                CorrespSht.Cells(NbLineCorresp + 1, 1) = Trim(.Cells(A, 1))
                NbLineCorresp = NbLineCorresp + 1
            End If
        Else
            If Not IsError(Application.Match(Trim(.Cells(A, 2)), Range(CorrespSht.Cells(2, 2), CorrespSht.Cells(NbLineCorresp, 2)), 0)) Then
                B = Range(CorrespSht.Cells(1, 2), CorrespSht.Cells(NbLineCorresp, 2)).Find(what:=Trim(.Cells(A, 2)), lookat:=xlWhole).Row
                CorrespSht.Cells(B, 1) = Trim(.Cells(A, 1))
            Else
                If Len(Trim(.Cells(A, 2))) > 3 And Left(Trim(.Cells(A, 2)), 3) <> "WWW" And Left(Trim(.Cells(A, 2)), 4) <> "HSTV" _
                And Left(Trim(.Cells(A, 2)), 4) <> "EPIQ" Or Len(Trim(.Cells(A, 2))) = 3 Then
                    CorrespSht.Cells(NbLineCorresp + 1, 2) = Trim(.Cells(A, 2))
                    CorrespSht.Cells(NbLineCorresp + 1, 1) = Trim(.Cells(A, 1))
                    NbLineCorresp = NbLineCorresp + 1
                End If
            End If
        End If
    Next A
End With
 
TSMBk.Close savechanges:=False
CouplBk.Close savechanges:=False
End Sub

n°1634024
Ricardo69
Posté le 30-10-2007 à 18:11:44  profilanswer
 

Merci pour la réponse. Mais en fait je ne veux pas forcément que mes fichiers csv s'ouvrent dans Excel.  
Je veux seulement les enregistrer dans mon projet et utiliser certaines données de ces fichiers. (Les valeurs du fichiers ne doivent pas apparaitre, je dois faire mes opérations en travail masqué en fait)
 
Il faudrait que chacun de mes fichiers csv soit enregistré sous un nom différent.  
Je ne sais pas si cela est possible et si mes explications sont assez claires mais j'espere que quelqu'un pourra m'aider.
Merci.

n°1634038
devil_k
Posté le 30-10-2007 à 18:30:34  profilanswer
 

Bah...  
Tu l'ouvres, soit en tant que classeur, soit en tant que fichier texte à l'aide du FileSystemObject , tu récupères ce que tu veux, et tu le refermes
Application.ScreenUpdating=false si tu veux que ça ne soit pas perceptible à l'écran

n°1634608
Ricardo69
Posté le 31-10-2007 à 12:44:40  profilanswer
 

Merci pour ton aide devil_k. Je pense que je vais pouvoir me débrouiller maintenant..


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Exploiter Données fichiers csv sur excel

 

Sujets relatifs
Erreur Excel/VB - Microsoft FormsProblème entre excel et vb
vba - Excel - Tri de lignes via une tmplist()Affiche de données au passage de la souri
Architecteure Client/serveur - base de données ACCESS ajout de données par fichier independant
[VBA Excel]Compter à l'interieur d'une chaine[VBA EXCEL] Problème avec partage de classeur !!
[Résolu] Lister les fichiers d'un dossierProblème pour générer la DTD de fichiers XML
Plus de sujets relatifs à : Exploiter Données fichiers csv sur excel


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