XL 2013 Problème de tableau VBA

[jpmetge]

Bonjour,

J'ai un souci avec une macro que j'ai récupéré sur un forum.
Elle permet de lire un fichier .csv sans l'ouvrir puis le stocker dans une table, et enfin recopier son contenu dans une feuille excel.
Cette macro fonctionne lorsque j'ai un fichier de peu de lignes, mais affiche le message suivant lorsque j'utilise mon fichier complet:

Je soupçonne la déclaration de mon tableau tab_lu, mais j'ai essayé plusieurs déclarations sans succès.
Voici mon code :
---------------------------------------------------------
Sub remplir_tab()

Dim var As Variant
Dim tab_val()
Dim tab_lu()
Dim i, j, cpt As Integer

'ouvre et lie le fichier fastclose et le stocke en mémoire
fich_in = Application.GetOpenFilename("Fichiers csv, *.csv")
'vérification des données dans le fichier

cpt = 0
caract_en_erreur = "*?!%"
erreur_lec = False
num_fich = FreeFile

Open fich_in For Input As #num_fich
Do While Not EOF(num_fich)


Line Input #num_fich, textline
' compteur
cpt = cpt + 1

' boucle des caractères invalides

For i = 1 To Len(caract_en_erreur)
erreur_lue = Mid(caract_en_erreur, i, 1)
caractere = InStr(1, textline, erreur_lue)
If caractere <> 0 Then
erreur_lec = True
End If
Next i

'dimensionnement des champs
tab_lu = Split(textline, ";")


'dimensionnement du tableau
ReDim Preserve tab_val(UBound(tab_lu, 1) + 1, cpt)

' boucle de chargement des données
For j = 1 To UBound(tab_lu, 1)
tab_val(j, cpt) = tab_lu(j - 1)
Next j


Loop
FinTab = cpt
Close #num_fich
Sheets("Prévisionnel").Activate

Range("A4:K9999").End(xlUp).ClearContents

For j = 3 To FinTab
For i = 1 To 11
Cells(j, i) = tab_val(i, j)
Next i
Next j
End Sub
-----------------------------------------------
Merci pour vos réponses.
Jean-Paul

 

[patricktoulon]

re
bonjour

c'est peut etre par ce que tu a un nombre trop important de ligne
vba limite le nombre de ligne du tableau en fonction de ce q'il y a dedans
ca ne sera pas la même chose si c'est des numériques ou string

 

[jpmetge]

Bonjour patricktoulon,
Je ne pense pas que le problème vienne de la taille de mon fichier qui ne fait que 47 lignes (18 ko).
Merci tout de même pour ta réponse.

 

[patricktoulon]

re
47 ligne et combien de colonne par ligne ?
on peut avoir un exemple bidonné de ce fichier avec tout son contexte (y compris les caracteres a replacer etc....)

car en effet
tu split ton texte par les ";"
tu n'a donc qu'une ligne et x colonnes dans ta variable tableau (sans doute trop important )

 

[dg62]

Bonjour le fil,

A quoi correspond Var déclaré en variant ? (Var est une fonction de feuille encore implémentée)

 

[patricktoulon]

re
tiens essaie ça plutôt
j'ai fait vite fait déclare les variables si j'en ai oublié

Sub remplir_tab()

    Dim laChaine As String, x, fich_in As String
    Dim tbl, tbl2()
    'ouvre et lie le fichier fastclose et le stocke en mémoire
    fich_in = Application.GetOpenFilename("Fichiers csv, *.csv")
    'vérification des données dans le fichier
    x = FreeFile
    Open fich_in For Binary Access Read As #x: laChaine = String(LOF(x), " "): Get #x, , laChaine: Close #x
    tbl = Split(laChaine, vbCrLf)
    For i = LBound(tbl) To UBound(tbl)
        tblligne = Split(tbl(i), ";")
        ReDim Preserve tbl2(UBound(tbl), UBound(tblligne))
        For c = LBound(tblligne) To UBound(tblligne)
            tbl2(i, c) = tblligne(c)
        Next
    Next
Cells(1, 1).Resize(UBound(tbl2) + 1, UBound(tbl2, 2) + 1) = tbl2
End Sub

 

[Staple1600]

Bonjour le fil, jpmetge

Bonjour,

J'ai un souci avec une macro que j'ai récupéré sur un forum.
Elle permet de lire un fichier .csv sans l'ouvrir puis le stocker dans une table, et enfin recopier son contenu dans une feuille excel.

Pourquoi ne pas utiliser la fonction prévue à cet effet par Excel?

Sub Importer_CSV()
Dim strPath$
strPath = ThisWorkbook.Path & "\" '<-  à adapter (si besoin)
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & strPath & "FichierTest.csv", Destination:=Cells(1)) '-< changer le nom du CSV
  .Name = "FichierTest" '<- changer également ici
  .FieldNames = True: .PreserveFormatting = True
  .RefreshStyle = xlInsertDeleteCells: .SaveData = True
  .AdjustColumnWidth = True: .RefreshPeriod = 0
  .TextFilePlatform = 1250: .TextFileStartRow = 1
  .TextFileParseType = 1: .TextFileTextQualifier = 1
  .TextFileConsecutiveDelimiter = False: .TextFileSemicolonDelimiter = True
  .Refresh BackgroundQuery:=False
End With
End Sub

 

[patricktoulon]

re
@Staple1600 ajoute le .delete a la fin du with pour se débarrasser du querytable

 

[Staple1600]

Re

En creusant, j'ai retrouvé ceci dans mes archives XLDiennes
(j'avais commis cela (avec quelques corrections de job75) en mars 2018
Je retourne au tableau (sans craie mais avec l'array )
NB: Il y a un petit bonus au niveau ergonomie

Sub Import_CSV_II()
'dernières modif: 171119 - staple1600 -> XLD|(p)20038406
Dim fichier, MyData$, strData$(), a(), i&
fichier = Application.GetOpenFilename("Fichier CSV (*.csv),*.csv", , "Choisissez le fichier à importer...")
If fichier = False Then Exit Sub
Application.ScreenUpdating = False
Open fichier For Binary As #1: MyData = Space$(LOF(1)): Get #1, , MyData: Close #1
strData() = Split(MyData, vbCrLf): ReDim a(UBound(strData), 0)
For i = 0 To UBound(a): a(i, 0) = strData(i): Next
With ActiveSheet
    .Cells.Clear: .[A1].Resize(UBound(a)) = a
    .Columns(1).TextToColumns .Cells(1), xlDelimited, Semicolon:=-1
    On Error Resume Next
End With
End Sub

 

[patricktoulon]

re
et petit malus because inscription ligne par ligne
donc déclenchement du calculate et compagnie a chaque tours

tu vois bien la différence a partir de 500 lignes rien que pour l'insertion
sans parler du textocolumn après

 

[Staple1600]

Re

Et toujours issu de ma ponte de mars 2018, la version light du code du message#7
(toujours avec le petit bonus ergonomique )

Sub Importer_CSV_I()
Dim ws As Worksheet, fichier: Set ws = ActiveSheet
fichier = Application.GetOpenFilename("Fichier CSV (*.csv),*.csv", , "Choisissez le fichier à importer...")
If fichier = False Then Exit Sub
Application.ScreenUpdating = False: Application.DisplayAlerts = False
On Error Resume Next
    With ws.QueryTables.Add(Connection:="TEXT;" & fichier, Destination:=ws.Cells(1))
      .TextFileParseType = 1
      .TextFileSemicolonDelimiter = -1
      .Refresh
    End With
End Sub

=>patricktoulon
Ici le demandeur parle d'un fichier de 47 lignes.
Donc je me fous du malus

 

[patricktoulon]

re
non excuse j'ai mal vu
mais je pige pas le strdata() to a() c'est quoi l'utilité?
transpose c'est pas suffisant?

 

[Staple1600]

Re

C'est pour ne pas subir les conséquence des limitations de Application.Transpose
De toute façon, pour ouvrir un fichier de 47 lignes, a-t-on vraiment besoin de sortir le VBA?

(Parce que tout peut se faire à la souris avec l'Assistant d'Importation et/ou Power Query sur les dernières versions d'Excel, non ?)

 

[jpmetge]

Sub remplir_tab() Dim laChaine As String, x, fich_in As String Dim tbl, tbl2() 'ouvre et lie le fichier fastclose et le stocke en mémoire fich_in = Application.GetOpenFilename("Fichiers csv, *.csv") 'vérification des données dans le fichier x = FreeFile Open fich_in For Binary Access Read As #x: laChaine = String(LOF(x), " "): Get #x, , laChaine: Close #x tbl = Split(laChaine, vbCrLf) For i = LBound(tbl) To UBound(tbl) tblligne = Split(tbl(i), ";") ReDim Preserve tbl2(UBound(tbl), UBound(tblligne)) For c = LBound(tblligne) To UBound(tblligne) tbl2(i, c) = tblligne(c) Next Next Cells(1, 1).Resize(UBound(tbl2) + 1, UBound(tbl2, 2) + 1) = tbl2 End Sub

Bonjour,
Toujours la même erreur :

 

[jpmetge]

Re-bonjour à tous,

J'ai testé la solution de Stample 1600 qui fonctionne parfaitement.
Merci à tous pour vos recherches?
Je clos la discussion