Discussion :

[Piixx_e]

Bonjour,

Pour faire bref : à partir de deux feuilles Excel, j'ai enregistré un tableau de 3 colonnes par beaucoup de lignes (quand je dis beaucoup c'est que c'est souvent entre 500 et 800 mille lignes) dans un fichier texte Fichier1 avec la 1ère feuille Excel et un tableau de 3 colonnes par également beaucoup de lignes dans un autre fichier texte Fichier2 avec la 2e feuille Excel.

Ce que je fais à la main et que je voudrais donc insérer dans ma macro : copier le contenu du Fichier2 à la suite du Fichier1 et enregistrer le nouveau fichier texte Fichier3 dans le répertoire qui contenait Fichier1 et Fichier2.

Je pourrais aussi directement copier le contenu de la 2e feuille Excel dans Fichier1, mais je ne sais pas le faire.

J'ai trouvé quelques idées sur internet, mais pour seulement rajouter quelques lignes à un fichier texte, pas pour y coller 3 colonnes de valeurs.

Par exemple :

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub bla()
 
Dim intFic As Integer
 
intFic = FreeFile
Open "Z:\Config\Bureau\test.txt" For Append As intFic
Print #intFic, "Une ligne"
Close intFic
 
End Sub

Il y aurait une histoire de TextStream pour ce que je veux faire, j'ai trouvé un exemple mais je n'y comprends pas grand chose..

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Dim oFSO As Scripting.FileSystemObject
Dim oFl As Scripting.File
Dim oTxt As Scripting.TextStream
Dim i As Integer
'Instanciation du FSO
Set oFSO = New Scripting.FileSystemObject
Set oFl = oFSO.GetFile("D:\Essai\monfichier.txt")
Set oTxt = oFl.OpenAsTextStream(ForWriting)
With oTxt
    For i = 0 To 10
        .WriteLine i
    Next i
End With

Peut-être que quelques-uns sur ce forum maîtrise cette partie de VBA, s'ils veulent bien me donner un coup de main, ce serait vraiment sympa

Merci d'avance pour votre aide !

[mercatog]

Tu avais une solution qui te générait directement un seul fichier comportant les données des 2 feuilles.

Il te restait de faire le petit calcul intermédiaire (comme tu l'as appelé) mais bref tu as choisi de contourner l'idée au lieu de la confronter.


Pour ta question, regarde dans la FAQ et les tutos comment lire et écrire dans un fichier texte. C'est basique et de niveau débutant.

[Piixx_e]

Euh, comment ça contourner l'idée ? Je sais que tu as suivi mon problème précédent, et c'est peut-être par rapport à la solution que tu m'avais proposé que tu me dis ça, mais le problème est qu'après avoir obtenu mes tableaux qui ont filtrés les points faux, je dois encore effectuer des opérations sur les données en enlevant les 2 premières colonnes puis en soustrayant, multipliant et divisant une colonne de coordonnées par des valeurs précises.

Je ne peux donc pas directement coller le tableau obtenu dans un fichier texte avant tout cela !

A la limite je pourrais générer à nouveau un tableau "virtuel" pour utiliser ce que tu m'avais proposé dans le dernier post, je viens seulement d'y penser mais il y a peut-être une façon plus directe d'y arriver, d'où ma question !

C'est pourquoi je cherche à savoir comment utiliser la macro pour copier mes valeurs de la 2e feuille à la suite de celles de la première feuille que j'aurais déjà enregistré dans un fichier texte.

Voilà voilà, je ne voulais pas paraître esquiver une solution, au contraire j'aimerais comprendre la manière la plus directe

Merci pour les liens en tout cas, je vais jeter un oeil à tout ça

[mercatog]

mes tableaux qui ont filtrés les points faux, je dois encore effectuer des opérations sur les données en enlevant les 2 premières colonnes puis en soustrayant, multipliant et divisant une colonne de coordonnées par des valeurs précises.

Qui t'empêche de faire ces calculs dans la variable tableau obtenue?

Pour soustraire, multiplier ou enlever 2 colonnes, pas besoin de passer par une feuille excel.

Je crois que tu n'as pas pigé l'utilité de passer par des variables tableaux pour des cas précis (dont le tien je suppose)

Je salue ton entêtement d'utiliser Excel pour ton traitement, mais pour les assez grand nombre de données, excel a des limites flagrantes de ressources et de temps.

[Piixx_e]

Qui t'empêche de faire ces calculs dans la variable tableau obtenue?

En effet, je n'y avais simplement pas pensé en fait. Je n'avais effectivement pas compris l'utilité des variables tableaux, mais ce n'est peut-être pas nécessaire de me le dire de cette façon, je suis justement venu sur le forum parce que je bloquais et que j'espérais qu'on me donnerait des pistes de réflexion

C'est chose faite en tout cas, Mercatog je te remercie une nouvelle fois de ton aide, je vais tester tout de suite cette solution

EDIT : Je suis rapidement de retour, parce que j'ai une lacune là-dessus : il est possible de redimensionner un tableau en lui disant de garder seulement les trois dernières colonnes ? Ou il faut que j'échange les colonnes de place pour que les colonnes à effacer soit les deux dernières ?
Sinon je peux coller le tableau dans Excel, et le refaire ensuite, mais puisque l'utilité des variables tableaux pourrait éviter cela, j'aimerais bien savoir si c'est vraiment possible

Désolée mais mon niveau n'est pas vraiment fou en VBA, je ne connais pas toutes les possibilités :/

EDIT 2 : Finalement, j'ai trouvé comment faire, directement dans la boucle où je générais mon tableau, j'ai changé une ligne :

Code :

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

1
2
            For m = 1 To 5
                Res(k, m) = Tb(i, m)

est devenu :

Code :

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

1
2
            For m = 3 To 5
                Res(k, m - 2) = Tb(i, m)

Comme ça j'ai directement le tableau de la taille que je veux !
Je pourrais ensuite faire les opérations également directement sur le tableau.
Reste à réussir à comprendre le code que tu m'avais donné précédemment, c'est une autre histoire, mais let's go !

[nibledispo]

Bonjour,

Le but n'est pas seulement de recevoir mais également de donner.

je te renvoie à ta conclusion du précédent post.

EDIT FINAL :

Bon eh bien au final, j'ai réussi à régler ce problème de lignes vides, à enregistrer les fichiers dans un seul fichier texte, et à améliorer le code grâce à vos conseils !
Merci à tous ceux qui m'ont aidée

il ne t'est pas venu à l'esprit que le code final pouvait intéresser ceux qui ont suivi la discussion et se sont retrouvés largués faute de la présence du code complet rectifié à partir des lignes vides et faute aussi d'avoir le fichier des données anonyme que je t'ai demandé pour faire des essais représentatifs.

En effet, des gens -dont je suis- ne peuvent participer sans possibilité de faire des essais.

cordialement,

[Piixx_e]

Bonjour,

Le but n'est pas seulement de recevoir mais également de donner.

il ne t'est pas venu à l'esprit que le code final pouvait intéresser ceux qui ont suivi la discussion et se sont retrouvés largués faute de la présence du code complet rectifié à partir des lignes vides et faute aussi d'avoir le fichier des données anonyme que je t'ai demandé pour faire des essais représentatifs.

Oula. Euh, détendons-nous ?

Il n'y avait plus beaucoup de réponses à la fin de mon post, alors j'ai dit que j'avais résolu le problème, pour que justement, si quelqu'un passait plus tard, il puisse demander le code, autrement, comme je n'avais plus trop de réponses je me suis dit que ça ne servait pas de le mettre. Visiblement je me suis trompée et je m'en excuse, je serais ravie de partager ma trouvaille, je le ferais dans l'après-midi.

Dans le post ci-dessus, j'ai d'ailleurs expliqué ce que j'avais trouvé toute seule. J'ai même été confrontée à un souci que j'ai réussi à régler seule sans poser de questions sur le forum, et lorsque j'ai vu un post sur le forum qui traitait quasiment du même problème, je me suis empressée de lui expliquer comment j'avais fait, alors bon je n'apprécie pas trop qu'on me dise qu'il ne s'agit pas seulement de recevoir mais aussi de donner...

Bref, il semble que j'ai été mal comprise mais l'impression d'être un peu envoyée bouler dans les posts ci-dessus m'a mis un peu mal à l'aise, je demandais juste de l'aide, et si je peux aider quelqu'un d'autre, je le ferais avec joie.

Petit pavé qui j'espère fera comprendre mes vraies intentions et effacera l'impression que vous sembliez avoir de moi.

[Piixx_e]

Bonjour !

J'ai tâché de faire du mieux que je pouvais, et voilà ce que j'ai :

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
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
91
92
93
94
95
Option Explicit
 
Const Sep As String = vbTab
Dim Tmp As String
Dim l As Integer, Moy As Double
Dim t0 As Double, N As Double, w As Double, R As Double, Multipl As Double
 
Sub PointsFaux()
Dim Chemin As String, Fichier As String
Dim P As Integer
Dim T As Single
Dim DerCell_1 As Double, DerCell_2 As Double
Dim Nom As String
 
DerCell_1 = Worksheets(1).Range("A1").End(xlDown).Row
DerCell_2 = Worksheets(2).Range("A1").End(xlDown).Row
Moy = Application.Average(Worksheets("Feuil1").Range("D2:D" & DerCell_1), Worksheets("Feuil2").Range("D2:D" & DerCell_2))
t0 = Worksheets("Feuil1").Range("E1")
N = 0.158
w = WorksheetFunction.Pi * N / 30
R = 400.38
Multipl = w * R
 
T = Timer
 
With ThisWorkbook
     Nom = Mid(.Name, 1, InStrRev(.Name, ".") - 1) & ".txt"
End With
 
Tmp = "Gpe" & Sep & "N°" & Sep & "X" & Sep & "Y" & Sep & "Z" & vbNewLine
 
l = 1
SupFaux Worksheets("Feuil1")
l = 2
SupFaux Worksheets("Feuil2")
 
Tmp = Replace(Tmp, vbNewLine & Sep, vbNewLine)
 
N = FreeFile
Open Nom For Output As #P
Print #P, Left(Tmp, Len(Tmp) - 1)
Close #P
 
MsgBox "Traitement terminé en " & Timer - T & " secondes"
End Sub
 
Private Sub SupFaux(Ws As Worksheet)
Dim DeltaX As Double, DeltaZ As Double, Ang As Double
Dim LastLig As Long, i As Long, j As Long, k As Long
Dim Passe As Boolean
Dim m As Byte
Dim Tb, Res()
 
Application.ScreenUpdating = False
With Ws
    .Select
    LastLig = .Rows.Count
 
    Tb = .Range("A1:E" & LastLig)
    ReDim Res(1 To LastLig, 1 To 3)
 
    j = 1
    For i = 1 To LastLig
        If i > 2 Then
            If Tb(i, 1) = "" Then Exit For
 
            If Tb(i, 4) < Moy Then
                Passe = True
            Else
                If Tb(i, 1) > Tb(i - 1, 1) Then
                    DeltaX = Tb(i, 3) - Tb(j, 3)
                    DeltaZ = Tb(i, 4) - Tb(j, 4)
                    If DeltaX <> 0 And DeltaZ <> 0 Then Ang = Application.WorksheetFunction.Atan2(Abs(DeltaX), Abs(DeltaZ))
                    If Abs(Ang) > 0.87 Then Passe = True
                End If
            End If
        End If
 
        If Not Passe Then
            j = i
            k = k + 1
            For m = 3 To 5
                If m = 5 Then
                    Tb(i, m) = (Tb(i, m) - t0) / 10000 * Multipl
                End If
            Tmp = Tmp & Sep & Tb(i, m)
            Next m
 
        Else
            Passe = False
        End If
    Next i
 
End With
End Sub

Sauf que... (eh oui sinon c'est pas drôle) le programme a énormément ralenti.. Alors qu'il allait vite avant que j'introduise le Tmp ! C'est dommage parce que ça me permettait de tout avoir dans un fichier texte.

Quelqu'un saurait d'où ça pourrait venir ?

Code avant TMP (qui marche super bien mais qui me donne deux fichiers texte que je dois manuellement "fusionner") :

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
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
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
Dim l As Integer
Dim Moy As Double
Dim t0 As Double
Dim N As Double, R As Double, Multipl As Double
 
Sub glo2parties()
Application.ScreenUpdating = False
Call PointsFaux
Call text
Application.ScreenUpdating = True
End Sub
 
Sub PointsFaux()
 
DerCell_1 = Worksheets(1).Range("A1").End(xlDown).Row
DerCell_2 = Worksheets(2).Range("A1").End(xlDown).Row
Moy = Application.Average(Worksheets("Feuil1").Range("D2:D" & DerCell_1), Worksheets("Feuil2").Range("D2:D" & DerCell_2))
t0 = Worksheets("Feuil1").Range("E1")
N = 0.158
w = WorksheetFunction.Pi * N / 30
R = 400.38
Multipl = w * R
 
l = 1
SupFaux Worksheets("Feuil1")
l = 2
SupFaux Worksheets("Feuil2")
 
End Sub
 
Private Sub SupFaux(Ws As Worksheet)
Dim DeltaX As Double, DeltaZ As Double, Ang As Double
Dim LastLig As Long, i As Long, j As Long, k As Long
Dim Passe As Boolean
Dim m As Byte
Dim Tb, Res()
 
Application.ScreenUpdating = False
With Ws
    .Select
    LastLig = .Rows.Count
 
    Tb = .Range("A1:E" & LastLig)
    ReDim Res(1 To LastLig, 1 To 5)
    ReDim Res2(1 To k, 1 To 3)
 
    j = 1
    For i = 1 To LastLig
        If i > 2 Then
            If Tb(i, 1) = "" Then Exit For
 
            If Tb(i, 4) < Moy Then
                Passe = True
            Else
                If Tb(i, 1) > Tb(i - 1, 1) Then
                    DeltaX = Tb(i, 3) - Tb(j, 3)
                    DeltaZ = Tb(i, 4) - Tb(j, 4)
                    If DeltaX <> 0 And DeltaZ <> 0 Then Ang = Application.WorksheetFunction.Atan2(Abs(DeltaX), Abs(DeltaZ))
                    If Abs(Ang) > 0.87 Then Passe = True
                End If
            End If
        End If
 
        If Not Passe Then
            j = i
            k = k + 1
            For m = 3 To 5
                Res(k, m - 2) = Tb(i, m)
            Next m
            Res(k, 3) = (Res(k, 3) - t0) / 10000 * Multipl
        Else
            Passe = False
        End If
    Next i
 
If Tb(1048576, 1) <> "" Then
        DerCell = 1048576
    Else: DerCell = .Range("A1").End(xlDown).Row
    End If
 
End With
 
Worksheets.Add.Select
ActiveSheet.Name = "Result" & l
ActiveSheet.Range("A1:E" & k) = Res
 
End Sub
 
Sub remplissage()
 
Dim col As Integer
Dim Val As Double, Multipl As Double
Dim Zone As Range
Dim N As Double, w As Double, R As Double
 
rempl Worksheets("Result1")
rempl Worksheets("Result2")
 
End Sub
 
Sub text()
With ThisWorkbook
     Nom1 = Mid(.Name, 1, InStrRev(.Name, ".") - 1) & "_1" & ".txt"
     Nom2 = Mid(.Name, 1, InStrRev(.Name, ".") - 1) & "_2" & ".txt"
End With
 
Sheets("Result1").Select
    ActiveWorkbook.SaveAs Filename:="monchemin" & Nom1, FileFormat:=xlText, CreateBackup:=False
    Sheets("Result2").Select
    ActiveWorkbook.SaveAs Filename:="monchemin" & Nom2, FileFormat:=xlText, CreateBackup:=False
 
'à la place de mon chemin apparaît bien sûr mon chemin normal
End Sub

Du coup ce serait mieux de juste mettre un code à la fin pour copier le contenu du fichier2 dans le fichier1, mais je ne sais pas faire ça, et peut-être d'ailleurs que ce sera très long à faire ?

[Piixx_e]

Rebonjour !

Je viens de tomber sur un sujet similaire qui répond finalement à ma question de savoir comment copier le contenu d'un fichier texte dans un autre. Pour ceux que ça intéresse, voilà le message qui a résolu mon problème :

Tu as une commande simple, utilisant le dos, pour fusionner autant de fichiers texte que tu le souhaites :

Code :

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

1
2
3
Sub test()
Shell ("cmd /c copy d:\txt\fichier1.txt+d:\txt\fichier3.txt d:\txt\fichier4.txt")
End Sub

Où "d:\txt\fichier4.txt" est le nouveau fichier contenant les deux fichiers précédents.
Tu peux remplacer le nom de tes fichiers par des variables.

Code :

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

Shell ("cmd /c copy " & var1 & "+" & var2 & " " & var3)

Bonne journée

NB - J'ignore si cette syntaxe fonctionne avec Vista (?)

Message qui vient de cette discussion :
http://www.developpez.net/forums/d60...fichier-texte/

Un grand merci à lui, pile ce qu'il me fallait

[mercatog]

Bon voilà mon ultime proposition sur ce sujet et surtout avec celui-là http://www.developpez.net/forums/d13...-donnees-lent/.

Avec optimisation effective des actions.

Testé sur un fichier où les 2 feuilles sont remplies (soit 2 x 1048576 lignes)
Le fichier texte engendrée contient 855238 lignes. Code exécuté en moins de 18 secondes générant un seul fichier contenant les données des 2 feuilles.

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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
Option Explicit
 
Const Sep As String = vbTab                      '";"
Const AngMax As Double = 0.87
Const N As Double = 0.158
Const R As Double = 400.38
 
Dim Moy As Double, T0 As Double, Multipl As Double
Dim LastLig As Long, k As Long
Dim Res() As String
 
Sub PointsFaux()
Dim NomFichier As String
Dim P As Integer
Dim i As Long
Dim Tim As Single
 
Tim = Timer
 
Moy = Application.Average(Worksheets("Feuil1").Range("D:D"), Worksheets("Feuil2").Range("D:D"))
T0 = Val(Worksheets("Feuil1").Range("E1"))
Multipl = WorksheetFunction.Pi * N * R / 30
 
LastLig = Application.Rows.Count
ReDim Res(1 To 2 * LastLig)
 
SupFaux Worksheets("Feuil1")
SupFaux Worksheets("Feuil2")
 
If k > 0 Then
    NomFichier = ThisWorkbook.FullName
    NomFichier = Left(NomFichier, InStrRev(NomFichier, ".")-1) & "_" & Format(Date, "yyyymmdd hhnn") & ".txt"
 
    P = FreeFile
    Open NomFichier For Output As #P
    For i = 1 To k
        Print #P, Res(i)
    Next i
    Close #P
    k = 0
Else
    MsgBox "Aucune donnée"
End If
Erase Res
MsgBox "Traitement terminé en " & Timer - Tim & " secondes"
End Sub
 
Private Sub SupFaux(Ws As Worksheet)
Dim DeltaX As Double, DeltaZ As Double, Ang As Double
Dim i As Long, j As Long
Dim Passe As Boolean
Dim Tb
 
With Ws
    Tb = .Range("A1:E" & LastLig)
    j = 1
    For i = 1 To LastLig
        If Tb(i, 1) = "" Then Exit For
        If i > 1 Then
            If Tb(i, 4) < Moy Then
                Passe = True
            Else
                If Tb(i, 1) > Tb(i - 1, 1) Then
                    DeltaX = Tb(i, 3) - Tb(j, 3)
                    DeltaZ = Tb(i, 4) - Tb(j, 4)
                    If DeltaX <> 0 And DeltaZ <> 0 Then Ang = Application.WorksheetFunction.Atan2(Abs(DeltaX), Abs(DeltaZ))
                    If Abs(Ang) > AngMax Then Passe = True
                End If
            End If
        End If
 
        If Not Passe Then
            k = k + 1
            Res(k) = Tb(i, 3) & Sep & Tb(i, 4) & Sep & (Tb(i, 5) - T0) / 10000 * Multipl
            j = i
        Else
            Passe = False
        End If
    Next i
End With
End Sub

[nibledispo]

Bonjour Mercatog,

Me souvenant que PIIX2 souhaitait avoir outre le fichier resultat .txt, le fichier excel.

Pour ce faire à partir de ton code j'ai posé

Code :

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

1
2
3
4
5
 
res1(k, 0) = Tb(i, 3)
res1(k, 1) = Tb(i, 4)
res1(k, 2) = (Tb(i, 5) - T0) / 10000 * Multipl
'MsgBox k & res1(k, 0) & "  " & res1(k, 1) & "  " & res1(k, 2)

avant la ligne

Code :

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

1
2
 
Res(k) = Tb(i, 3) & Sep & Tb(i, 4) & Sep & (Tb(i, 5) - T0) / 10000 * Multipl

(cela augmente le temps de traitement de manière non négligeable)

Et dans la procédure appelante j'ai posé juste après les appels :

Code :

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

1
2
 
Sheets("Feuil5").[A1].Resize(k, 3).Value = res1

bien sur j'ai dimensionné res1 avant son utilisation

Code :

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

1
2
 
ReDim res1(2 * LastLig, 3)

le "msgbox" posé pour contrôle indique bien les valeurs identiques au fichier .txt mais la copie du tableau res1 dans feuil5 ne se fait pas. je ne saisis pas pourquoi ?

Ceci étant dit, j'ai essayé le code de PIIXXE avant introduction tmp, le résultat est étonnant.

Il restitue bien une fichier résultat mais il modifie également le nom de l'application excel en .txt.

cordialement

[nibledispo]

Bonjour Mercatog,

Merci pour ta réponse.

J'ai regardé le document. je ne lis pas l'anglais mais j'ai cru comprendre que c'est la partie G qui nous concerne.

A l'aide d'un traducteur en ligne plus ou moins fiable, je crois comprendre que pour les versons 2000 et plus la limitation est uniquement celle de la mémoire (dans mon cas 16 GO).
L'erreur signalée est bien celle qui m'a été renvoyée, il va donc lieu de penser que le volume du tableau était > à 16 GO (surement moins de 16 car Excel et windows doivent déjà occuper un volume non négligeable).
Je ne vois au demeurant pas ce que la compatibilité de type vient faire dans ce problème. VBA pourrait mettre "mémoire insuffisante"

Pour ce qui est de "join", un intervenant dans la discussion d'hier et aujourd'hui "fusion de deux tableaux" affirme, si je l'ai bien compris, que cela ne peut pas apporter de bénéfice par rapport à une boucle "for next" car la fonction ferait elle même une boucle pour apporter sa réponse.

Cordialement,

[Invité]

Salut nibledispo,

Essaye ceci pour comprendre. C'est une limitation qu'il y a en VBA en utilisant les WorksheetFunction.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
Sub TestTranspose()
    Const N1 As Long = 65536
    Const N2 As Long = 65537
    Dim y, TabTemp()
 
    ReDim TabTemp(1 To N1)
    y = WorksheetFunction.Transpose(TabTemp) 'Pas d'erreur
    ReDim TabTemp(1 To N2)
    y = WorksheetFunction.Transpose(TabTemp) 'Erreur
 
End Sub

Si tu fais varier la Lower Bound de l'array, tu peux modifier en conséquence la Upper Bound (C'est la taille de l'array qui compte ici).

P.S.: Pour les vielles versions d'Excel, il est possible que cette fonction limite dès 256/Array au lieu des 65536 actuellement.

[nibledispo]

Bonjour,

Nouveau2:
Merci pour ton bout de code. Toutefois, je ne comprends pas car sur 2013 le nombre de lignes est supérieur à 1 000 000 et comme le transpose (voir plus haut) retournait moins de 700 000 lignes la limite n'était pas atteinte.

Piixx-2 :
excusez moi, je n'avais pas vu votre dernière intervention.

je vous joins le module sans 'join" qui met sur mon ordinateur 8s sans le résultat Excel et 150s avec le résultat Excel pour 2* 1 000 000 de lignes et 617 000 lignes Excel restituées
Le résultat est sur une feuille nommée "resultat" et les feuilles de données sont "feuil1" et "feuil2". A adapter donc.

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
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
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
 
'version sans 'join'
 
Option Explicit
Option Base 1
 
Const Sep As String = vbTab
Const AngMax As Double = 0.87
Const N As Double = 0.158
Const R As Double = 400.38
 
Dim Moy As Double, T0 As Double, Multipl As Double
Dim LastLig As Long, k As Long
Dim a As Long ' valable si emploi boucle for de la procédure appelante
Dim res() As String
Dim res1()
 
Sub PointsFaux()  'procédure appelante - demarrage
Dim NomFichier As String
Dim P As Integer
Dim i As Long, a As Long
Dim Tim As Single
 
Tim = Timer
Sheets("resultat").Columns("a:c").ClearContents 'peut être retiré si souhaité
Moy = Application.Average(Worksheets("Feuil1").Range("D:D"), Worksheets("Feuil2").Range("D:D"))
T0 = Val(Worksheets("Feuil1").Range("E1"))
Multipl = WorksheetFunction.Pi * N * R / 30
 
LastLig = Application.Rows.Count
ReDim res(1 To 2 * LastLig)
 
SupFaux Worksheets("Feuil1")
SupFaux Worksheets("Feuil2")
 
Sheets("resultat").Activate  'peut être retiré si souhaité
'1ère méthode remplissage direct de la feuille resultat
' ne passe pas pour cause de dépassement volume - marche avec un maximum de 2* 100 000 lignes environ
'Sheets("resultat").[a1].Resize(k, 3) = Application.Transpose(res1)
 
'2ème methode remplissage avec boucle
' passe indépendemment du volume et entre autre pour 2 * 1 000 000 de lignes
For a = 1 To k
    With Sheets("resultat")
        .Range("a" & a) = res1(1, a)
        .Range("b" & a) = res1(2, a)
        .Range("c" & a) = res1(3, a)
    End With
Next a
 
If k > 0 Then
    NomFichier = ThisWorkbook.FullName
    NomFichier = Left(NomFichier, InStrRev(NomFichier, ".") - 1) & "_" & Format(Date, "yyyymmdd hhnn") & ".txt"
    P = FreeFile
    Open NomFichier For Output As #P
    For i = 1 To k
        Print #P, res(i)
    Next i
    Close #P
 
Else
    MsgBox "Aucune donnée"
End If
 
MsgBox "Traitement terminé en " & Timer - Tim & " secondes"
 
k = 0
Erase res
Erase res1
End Sub
 
Private Sub SupFaux(Ws As Worksheet) ' procédure appelée
Dim DeltaX As Double, DeltaZ As Double, Ang As Double
Dim i As Long, j As Long ',
Dim Passe As Boolean
Dim Tb
 
With Ws
    Tb = .Range("A1:E" & LastLig)
    j = 1
    For i = 1 To LastLig
        If Tb(i, 1) = "" Then Exit For
        If i > 1 Then
            If Tb(i, 4) < Moy Then
                Passe = True
            Else
                If Tb(i, 1) > Tb(i - 1, 1) Then
                    DeltaX = Tb(i, 3) - Tb(j, 3)
                    DeltaZ = Tb(i, 4) - Tb(j, 4)
                    If DeltaX <> 0 And DeltaZ <> 0 Then Ang = Application.WorksheetFunction.Atan2(Abs(DeltaX), Abs(DeltaZ))
                    If Abs(Ang) > AngMax Then Passe = True
                End If
            End If
        End If
 
        If Not Passe Then
 
            k = k + 1
            ReDim Preserve res1(3, k)
            res1(1, k) = Tb(i, 3)
            res1(2, k) = Tb(i, 4)
            res1(3, k) = (Tb(i, 5) - T0) / 10000 * Multipl
 
            res(k) = Tb(i, 3) & Sep & Tb(i, 4) & Sep & Format((Tb(i, 5) - T0) / 10000 * Multipl, "General Number")
            j = i
        Else
            Passe = False
        End If
    Next i
 
End With
End Sub

Cordialement,

[Piixx_e]

Bonjour,

Toutefois, je ne comprends pas car sur 2013 le nombre de lignes est supérieur à 1 000 000 et comme le transpose (voir plus haut) retournait moins de 700 000 lignes la limite n'était pas atteinte

En effet je suis aussi perplexe que toi. J'ai retenté et en obtenant un tableau de 1048509 lignes, il ne veut pas.

Par contre, j'ai trouvé sur ce site : http://support.microsoft.com/kb/177991/fr, l'explication suivante (pour Excel 97 et 2000) :

Le nombre maximal d'éléments dans le tableau est limité par la mémoire disponible ou le Excel taille maximale des feuilles de calcul (65 536 lignes X 256 colonnes). Toutefois, le nombre maximal d'éléments dans le tableau que vous pouvez passer à Excel à l'aide de la transposer Excel fonction est 5461. Si vous dépassez cette limite, vous recevez message d'erreur suivantes :
Erreur d'exécution '13' :
Incohérence de type

Bon moi j'utilise Excel 2010, mais ça montre que le nombre de lignes max de Excel (pour moi, 1 048 576 lignes) ne correspond pas au nombre de lignes maximales du tableau (pour moi, c'est "k" lignes) qu'on peut mettre dans un fichier Excel. Il faudrait décomposer du coup, mais vu que je ne connais même pas cette valeur maximale de lignes transposables...

Quoiqu'il en soit, avoir le fichier Excel post macro n'est pas primordial mais ça aurait pu être utile par la suite.

Piixx-2 :
excusez moi, je n'avais pas vu votre dernière intervention.

je vous joins le module sans 'join" qui met sur mon ordinateur 8s sans le résultat Excel et 150s avec le résultat Excel pour 2* 1 000 000 de lignes et 617 000 lignes Excel restituées
Le résultat est sur une feuille nommée "resultat" et les feuilles de données sont "feuil1" et "feuil2". A adapter donc.

Merci beaucoup

Cependant, il se trouve qu'avec le fichier Excel que je viens d'ouvrir pour tester votre code, k > 1 048 576. Du coup, je ne peux tout mettre dans une feuille, mais ce n'est pas très compliqué de pouvoir dispatcher ça sur deux feuilles. Je pourrais même y intégrer un petit If k > 1 048 576 et pouvoir gérer les deux cas à la fois