Exploiter Données fichiers csv sur excel - VB/VBA/VBS - Programmation
Marsh Posté le 30-10-2007 à 17:52:41
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
Marsh Posté le 30-10-2007 à 17:56:41
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
Marsh Posté le 30-10-2007 à 18:11:44
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.
Marsh Posté le 30-10-2007 à 18:30:34
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
Marsh Posté le 31-10-2007 à 12:44:40
Merci pour ton aide devil_k. Je pense que je vais pouvoir me débrouiller maintenant..
Marsh Posté le 30-10-2007 à 17:40:53
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