Variable tableau et transpose

Version imprimable

25/07/2013, 00h15
casefayere

Variable tableau et transpose
Bonsoir ou bonjour à tou(te)s

J'ai une variable tableau à 1 dimension qui peut contenir plus de 700000 données

En faisant des essais, je me suis rendu compte que la fonction "transpose" ne cause pas de soucis pour 10 000 données mais me génère une erreur à 690 000 données
Code:

1 2 'nomf est une variable string, tbcol mon tableau Sheets(nomF).Range("A1").Resize(UBound(Tbcol), 1) = WorksheetFunction.Transpose(Tbcol)
je ne veux pas passer par une boucle, solution qui fonctionne, bien sur, mais allonge énormément le temps de traitement, donc ma question : quelqu'un connaitrait une parade ?
ci-dessous l'erreur générée sur la ligne
25/07/2013, 00h54
mercatog
Bonsoir Dominique

En effet, il y a une limitation dans l'utilisation de Transpose

Pour détourner cette limitation, utilise un tableau à 2 dimensions qui ne nécessite pas de Transpose

Exemple
Code:

1 2 3 4 5 6 7 8 9 10 11 Sub Test() Const N As Long = 700000 Dim i As Long Dim Tb(1 To N, 1 To 1) As Long For i = 1 To N Tb(i, 1) = Rnd() Next i Feuil1.Range("A1").Resize(N, 1) = Tb End Sub
25/07/2013, 01h19
Marc-L

Bonsoir Dominique,

pourrais-tu tester avec = Application.Transpose(Tbcol), sait-on jamais …

Bonsoir mercatog,
Merci pour ta réponse, pour tout te dire car je pense que tu connais le fichier de Sylkiroad que j'avais posté pour utiliser les GIF animés, j'essaie d'améliorer celui-ci, notamment en temps d'exécution.

le problème, c'est que je ne connais pas d'avance, la taille du tableau et passes par "Redim Préserve". Comme on ne peux pas redimensionner le tableau à 2 dimensions, j'ai corrigé le code en fonction. Je pourrais d'office, comme tu me le propose mettre "1 to 700 000" mais les fichiers GIF pourrons dépasser cette limite. Je me suis basé sur les fameux drapeaux Benin et France, aucun problème pour le drapeau français mais celui du Benin fait + de 690000 données. Je joins ci-dessous le code que j'avais préparé

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
Private Sub CommandButton1_Click()
    Dim S As String, Dl As Long, Dc As Long
    Dim Hauteur As Long, Largeur As Long
    Dim nomF As String, Tbcol(), t2()
    Dim Fichier As Variant, col As Long
    Dim i As Long, F As Long, j As Long
    Dim b As Byte, mes As String
    Dim Feuille As Worksheet
    'Affichage de la la boîte de dialogue standard "Ouvrir" pour sélectionner une image GIF
    'sur le disque dur.
    'GetOpenFilename permet de lire le nom du fichier sélectionné par l'utilisateur sans
    'réellement ouvrir le fichier.
    Fichier = Application.GetOpenFilename("Fichiers Images (*.gif),*.gif")
    
    'Vérifie si l'utilisateur a cliqué sur le bouton "Annuler" ou sur la croix de fermeture.
    If Fichier = False Then
        MsgBox "Opération Annulée"
        'pour sortir de la procédure
        Exit Sub
    End If
    col = 0
    '----------- message pendant le transfert ----
    'Permet de créer un message d'attente défilant dans le WebBrowser pendant le transfert
    'des données (au format binaire) dans les cellules de la nouvelle feuille.
    LeTexte = "Veuillez patienter... traitement en cours ..."
    LaCouleur = "#CC0000"
    
    WebBrowser1.Navigate _
    "about:<html><body BGCOLOR ='#CCCCCC' scroll='no'><font color= " & LaCouleur & _
    " size='5' face='Arial'>" & _
    "<marquee>" & LeTexte & "</marquee></font></body></html>"
    '----------------------------------------------
    'Boucle sur les données binaire du fichier sélectionné et alimente la variable tableau
    F = FreeFile
    Open Fichier For Binary Access Read As F
    
    While Not EOF(F)
        Get #F, , b
        'DoEvents
        col = col + 1
        ReDim Preserve Tbcol(1 To col)
        Tbcol(col) = b
    Wend
    Close F
    nomF = InputBox("Si vous voulez sauvegarder l'image dans le fichier" & Chr(10) & "Choisir un nom pour" & Chr(10) & "la feuille qui contiendra l'image")
    'Ajoute une feuille dans le claseur et la positionne à la fin.
    If nomF <> "" Then
      Set Feuille = ThisWorkbook.Worksheets.Add(After:=Sheets(Sheets.Count))
      'Renomme la feuille
      Feuille.Name = nomF
      'Masque la feuille
      Feuille.Visible = xlSheetHidden
        '--- transfert des données dans la feuille ----
        'Boucle sur la variable tableau et transfère les données dans les cellules de la feuille de calcul.
      Sheets(nomF).Range("A1").Resize(UBound(Tbcol), 1) = WorksheetFunction.Transpose(Tbcol)
      'For i = 1 To UBound(Tbcol)
        'Sheets(nomF).Range("A" & i) = Tbcol(i)
      'Next i
      End If
      mes = MsgBox("voulez-vous voir l'image, dès maintenant ?", vbYesNo)
      If mes = 6 Then
        '----- Création de l'image pour un affichage dans l'USF -----
        S = "C:\Users\Dominique\Documents\imageTemp.gif"
        F = FreeFile
        Open S For Binary Access Write As F
        For i = 1 To UBound(Tbcol)
          b = Tbcol(i)
          Put #F, , b
          DoEvents
        Next i
      Close F
      'Définit les dimensions d'affichage de l'image dans le WebBrowser.
      Largeur = WebBrowser1.Width * 96 / 72
      Hauteur = WebBrowser1.Height * 96 / 72
    
      'Affiche l'image dans le WebBrowser en supprimant les marges et les barres de défilement
      WebBrowser1.Navigate _
      "ABOUT:<HTML><CENTER><HEAD><body scroll='no' LEFTMARGIN=0 TOPMARGIN=0><IMG WIDTH=" & _
          Largeur & " HEIGHT=" & Hauteur & _
          " SRC='" & S & "'</IMG></BODY></CENTER></HTML>"

      ' Affiche une page blanche dans le webBrowser
      'WebBrowser1.Navigate "about:blank"
      Else
        MsgBox "Opération terminée"
        'Ferme et réouvre l'UserForm (permet une réinitialisation rapide)
        Unload Me
        UserForm1.Show
      End If
End Sub

Merci encore de t'intéresser à mon problème

Bonne soirée

25/07/2013, 01h37
casefayere

Bonsoir Marc,

Je n'avais pas vu ta réponse, merci, je peux essayer mais je ne pense pas que ça change quelque chose

PS : après essai je confirme, ça ne passe pas

Bonne soirée

Et si tu passes par un tableau intermédiaire?

Code:

1
2
3
4
5
6
7
8
9
Dim Res()
'....
ReDim Res(1 To col, 1 To 1)
For i = 1 To col
    Res(i, 1) = Tbcol(i)
Next i
 
'.....
Sheets(nomF).Range("A1").Resize(col, 1) = Res

25/07/2013, 01h57
casefayere

Je vais essayer dès demain car la fatigue me gagne sérieusement, je te tiendrai au courant, si le résultat est correct je joindrai le fichier en essayant de le vider des lignes de code inutiles ainsi que des variables qui ne servent plus

Bonne nuit à toi et à Marc
25/07/2013, 04h06
NVCfrm
bonsoir,

et si tu lisais avec une variable dimensionnée sur la taille du fichier
La fonction LOF te donne la taille d'un fichier ouvert.

Essaye:
Code:

1 2 3 4 5 6 7 Dim tbcol() as Byte,taille as long ... taille = FileLen(Fichier) Redim tbcol (1 to taille) Open Fichier For Binary Access Read As F Get #1, 1, trans'devra te remplir ton tableau
Sinon regarde du côté de l'api RtlMoveMemory.

re le forum, NVCfrm, mercatog, Marc

D'abord, je remercie également NVCfrm de m'avoir donné son conseil
Suite à une combinaison des propositions de mercatog et de NVCfrm, j'ai obtenu un fichier correct en l'état de mes essais. Je ne peux pas juger du temps d'execution sur une image gourmande car je n'en ai pas trouvé, le drapeau du Benin que je testais chez moi (là, je suis ailleurs) était beaucoup plus conséquent que celui présenté dans le fichier joint. Au cas où vous ne souhaitez pas consulter le fichier, voici le code transformé :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 ... ReDim Tbcol(1 To FileLen(Fichier), 1 To 1) 'ici adaptation de NVCfrm et de mercatog '----------- message pendant le transfert ---- 'Permet de créer un message d'attente défilant dans le WebBrowser pendant le transfert 'des données (au format binaire) dans les cellules de la nouvelle feuille. LeTexte = "Veuillez patienter... traitement en cours ..." LaCouleur = "#CC0000" WebBrowser1.Navigate _ "about:<html><body BGCOLOR ='#CCCCCC' scroll='no'><font color= " & LaCouleur & _ " size='5' face='Arial'>" & _ "<marquee>" & LeTexte & "</marquee></font></body></html>" '---------------------------------------------- 'Boucle sur les données binaire du fichier sélectionné et alimente la variable tableau i = 0 F = FreeFile Open Fichier For Binary Access Read As F While Not EOF(F) Get #F, , b DoEvents i = i + 1 If i <= FileLen(Fichier) Then Tbcol(i, 1) = b Wend Close F ...
Bonne journée

26/07/2013, 04h05
NVCfrm

Salut,

Un exemple de lecture de fichiers binaire que j'ai préféré posté dans les contributions.
http://www.developpez.net/forums/d13...aire-avec-get/