XL 2013 Problème de tableau VBA

jpmetge

XLDnaute Nouveau
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:

1573984609863.png

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

XLDnaute Barbatruc
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 )
 

patricktoulon

XLDnaute Barbatruc
re
tiens essaie ça plutôt
j'ai fait vite fait déclare les variables si j'en ai oublié
VB:
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

XLDnaute Barbatruc
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?
VB:
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
 

Staple1600

XLDnaute Barbatruc
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
VB:
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
 

Staple1600

XLDnaute Barbatruc
Re

Et toujours issu de ma ponte de mars 2018, la version light du code du message#7
(toujours avec le petit bonus ergonomique ;))
VB:
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 ;)
 

Staple1600

XLDnaute Barbatruc
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

XLDnaute Nouveau
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 :
1574119306523.png
 

Pièces jointes

  • fichier test.pdf
    226 KB · Affichages: 1

Discussions similaires

Haut Bas