Discussion :

[ouskel'n'or]

C'est bien la structure du premier fichier que tu as joint. Alors ton problème est ailleurs. Ou alors ton micro est une charrue qui tourne à 6 Mhz...
Tu devrais mettre ton fichier complet, qu'on teste en vrai.
Pour mettre + de 30 mn, sur "mon" micro il devrait avoir 37 605 298 lignes...
Donc, je conclus que cépaça...
As-tu testé le code brut que je t'ai mis, sur un classeur tout neuf, pour le fichier que tu as mis sur le forum ?
A+

[Daranc]

je viens d'avoir une illumination (et je crois qu'en m^me temp je dois avoir gagner la couronne du rois des c...) je n'ai pas le fichier sous la main mais dès que .. je regarde en désactivant le re calcul automatique si le code de KIKI ne passe pas mieux (son fichier en brut marche nickel . sur mon programme c'est excessivement long ).mais si la feuille se recalcule a chaque fois qu'une cellule est remplie ? même en désactivant le rafraîchissement de l'écran je dois avoir une petite lenteur non?
Daranc
Bon eh bien je mérite la couronne , c'était bien le recalcul qui me plombait le temps d'execution

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim nom As String
Dim PRF As Variant
Dim ActiF As String
Dim t As Long
Dim n As Integer
Dim DaTa() As Variant
Dim dAtA2() As Long
Dim y As Long
Dim p As Long
'** démarrage **
Application.ScreenUpdating = False
With Application
        .Calculation = xlManual
.MaxChange = 0.001
End With
ActiF = ThisWorkbook.name
nom = ThisWorkbook.Path
PRF = ListBox1.Value
nom = nom + "\" + PRF
'** Ouvre l'exemple de fichier en accès aléatoire.
Open nom For Input As #1
Do While Not EOF(1)
y = y + 1
ReDim Preserve DaTa(y)
Line Input #1, DaTa(y)
Loop
Close #1
n = 0
For p = 11 To y - 2 Step 4
ReDim Preserve dAtA2(n)
dAtA2(n) = CLng(DaTa(p))
n = n + 1
Next
'Workbooks(ActiF).Activate
Sheets(1).Select
Range("b:b").ClearContents
For g = 0 To n - 1
Sheets(1).Cells(11 + g, 2).Value = dAtA2(g)
Next
Unload Me
Application.DisplayAlerts = True
Application.ScreenUpdating = True
With Application
  .Calculation = xlManual
End With
End Sub
Private Sub UserForm_Initialize()
specdossier = ThisWorkbook.Path
Dim fs, F, f1, fc, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set F = fs.GetFolder(specdossier)
Set fc = F.Files
For Each f1 In fc
If Right(f1.name, 3) = "PRF" Then
ListBox1.AddItem f1.name
End If
Next
End Sub

ceci marche parfaitement
Merci
Daranc

[kiki29]

Salut, juste pour information ,un utilitaire pour une meilleure lisibilité du code http://www.oaltd.co.uk/Indenter/Default.htm

[Daranc]

j'ai finalement trouvé ce que je cherchais depuis le début

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim nom As String
Dim PRF As Variant
Dim ActiF As String
Dim t As Long
Dim n As Integer
Dim DaTa() As Variant
Dim dAtA2(0 To 30000, 0) As Long   'modification de la structure de data2
Dim y As Long
Dim p As Long
'** démarrage **
Application.ScreenUpdating = False
    ActiF = ThisWorkbook.name
    nom = ThisWorkbook.Path
    PRF = ListBox1.Value
    nom = nom + "\" + PRF
'** Ouvre l'exemple de fichier en accès aléatoire.
y = -1
Open nom For Input As #1
Do While Not EOF(1)
y = y + 1
ReDim Preserve DaTa(y)
Line Input #1, DaTa(y)
Loop
Close #1
n = 0
For p = 10 To y - 2 Step 4
'creation Data2
dAtA2(n, 0) = CLng(DaTa(p))
n = n + 1
Next
Sheets(1).Select
Range("b:b").ClearContents
plage$ = "b11:b" & n + 9 '9 remplace n-1 +10
Range(plage$).Value = dAtA2 ' le tablo esr posé d'un bloc sans désactivé le calcul auto
Unload Me
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Pour le lien je te remercie
mais je me perds dans un code indenté.Une mauvaise habitude que j'ai d'aligner mon code à droite et de ne pas laisser de ligne vide (je préfère les commentaires ou des lignes tracé ____ *****.Perso mon éditeur à le texte du commentaire en bleu sur fond gris (bon il faudra quand même que je me mette à l'anglais pour voir de quoi il s'agit)
De toute façon merci de votre aide
Daranc

[ouskel'n'or]

Alors le code que je t'ai passé, même s'il peut être amélioré, est tout de même moins lourd...
Créer deux tableaux et trois boucles alors qu'une seule suffit...
Ceci dit...
Bonne chance pour la suite