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

[Piixx_e]

Bonjour mercatog, bonjour nibledispo

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.

Je te remercie beaucoup pour ton code : il marche très bien ! Seul petit problème : au lieu de me mettre des nombres à virgules dans la troisième colonne il me met des nombres dans ce format : 1,12617790260218E-02.

Dans Excel, je savais changer ce problème, mais je t'avoue qu'en passant par un tableau, je ne sais pas trop comment m'y prendre.. A moins que ce soit la même chose que pour Excel en changeant le format du nombre ?

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

En fait le fichier Excel final ne m'intéresse pas vraiment, mais pourquoi pas le garder si ça ne rallonge pas trop le temps de traitement (mais tu as l'air de dire le contraire !)

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 ?

Peut-être parce que la feuille 5 n'existe pas au moment où tu lui demandes de copier les valeurs ? (mais je n'ai pas encore essayé de tester ton rajout de code je te l'avoue, alors c'est juste une supposition ! Mais je suppose que tu l'as créé avant de copier donc ça ne doit pas être ça. Peut-être un problème de dimension dans le code de ta ligne de copie ?)

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.

En fait, je lui dis d'abord de sauvegarder la 1ère feuille (mais quand on enregistre en .txt, même si l'on veut enregistrer toutes les feuilles, il ne peut enregistrer que la feuille active), du coup il me renomme mon fichier Excel avec le nom que je lui ai donné (avec donc l'extension .txt) puis il le renomme de nouveau avec le nom que je donne à la deuxième feuille de résultat.

Mais c'est vrai que c'est assez bizarre qu'il continue de le considérer comme un excel puisqu'il arrive à enregistrer ma 2e feuille de résultat..

Pour finir, je vous joins mon dernier code travaillé (comme je l'ai dit, celui de mercatog marche bien mis à part ce problème de format, mais je n'arrive pas à régler mon souci de fichier texte et j'aimerais y arriver )

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)
 
    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"
     Nom3 = Mid(.Name, 1, InStrRev(.Name, ".") - 1) & ".txt"
End With
 
Sheets("Result1").Select
    ActiveWorkbook.SaveAs Filename:="M:\Fichiers profils\" & Nom1, FileFormat:=xlText, CreateBackup:=False
    Sheets("Result2").Select
    ActiveWorkbook.SaveAs Filename:="M:\Fichiers profils\" & Nom2, FileFormat:=xlText, CreateBackup:=False
 
Shell ("cmd /c copy M:\Fichiers profils\*.txt M:\Fichiers profils\Fichier.txt")
End Sub

La dernière ligne se lance sans erreurs, mais ne crée pas le fichier texte voulu. Pourtant, j'ai essayé cette commande avec deux fichiers .txt nommés test1 et test2 que j'ai rempli de la même manière que mes fichiers .txt obtenus d'habitude (3colonnes de nombres) :

Code :

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

Shell ("cmd /c copy Z:\Config\Bureau\test1.txt + Z:\Config\Bureau\test2.txt Z:\Config\Bureau\test.txt")

Et tout a bien fonctionné !
Mais si je remplace par le bon chemin et que je copie/colle les noms de fichiers, il ne crée pas le fichier regroupant les deux autres, et là je ne comprends pas trop pourquoi.
D'ailleurs, si je remplace juste le chemin en mettant mes fichiers .txt de test dans le chemin où je mets mes fichiers (M:\Fichiers profils\, qui est sur ma clé USB), il ne veut plus copier.
Je peux passer par le bureau puis changer ensuite mon fichier final de chemin, mais je voulais savoir s'il n'était pas possible de changer simplement quelque chose dans mon code qui m'aurait échappé et qui permettrait d'avoir quelque chose qui marche

[mercatog]

Oui c'est ça

Remplace la ligne 74 du code par celle ci

Code :

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

Res(k) = Tb(i, 3) & Sep & Tb(i, 4) & Sep & Format((Tb(i, 5) - T0) / 10000 * Multipl, "General Number")

[PMO2017]

Shell ("cmd /c copy M:\Fichiers profils\*.txt M:\Fichiers profils\Fichier.txt")

La dernière ligne se lance sans erreur, mais ne crée pas le fichier texte voulu.

Bonjour,

La présence d'espace dans le chemin doit être la cause du dysfonctionnement. Essayez :

Code :

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

1
2
3
Dim A$
A$ = "cmd /c copy  " & Chr(34) & "M:\Fichiers profils\*.txt" & Chr(34) & space(1) & Chr(34) & "M:\Fichiers profils\Fichier.txt" & Chr(34)
Shell A$

[Piixx_e]

Génial ! Merci à vous deux ça fonctionne parfaitement

J'aurais juste une petite question de plus PMO2017 : est-ce que c'est possible de lui faire comprendre de ne prendre en compte que les fichiers .txt que je viens de faire ? Parce que mon souci est que je vais mettre tous mes fichiers résultats dans le même dossier. Du coup, s'il prend tous les fichiers texte pour en créer un, ça va poser problème !

Je les ai nommés comme ça :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub text()
With ThisWorkbook
     Nom1 = Mid(.Name, 1, InStrRev(.Name, ".") - 1) & "_1" & ".txt"
     Nom2 = Mid(.Name, 1, InStrRev(.Name, ".") - 1) & "_2" & ".txt"
     Nom3 = Mid(.Name, 1, InStrRev(.Name, ".") - 1) & ".txt"
End With
 
Sheets("Result1").Select
    ActiveWorkbook.SaveAs Filename:="M:\Fichiers profils\" & Nom1, FileFormat:=xlText, CreateBackup:=False
    Sheets("Result2").Select
    ActiveWorkbook.SaveAs Filename:="M:\Fichiers profils\" & Nom2, FileFormat:=xlText, CreateBackup:=False

Du coup ça aurait été top qu'il puisse identifier les fichiers Nom1 et Nom2 et qu'il crée le fichier Nom3, mais je n'arrive pas à lui faire comprendre ça. Sinon il faudrait que je crée des sous-dossiers mais le problème serait le même puisque j'aimerais ne pas avoir à rentrer manuellement le chemin détaillé du fichier, mais plutôt lui dire de ne considérer que ceux dont j'ai défini le nom plus haut.


J'ai tenté ceci :

Code :

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

1
2
3
Dim A$
A$ = "cmd /c copy  " & Chr(34) & "M:\Fichiers profils\Nom1" & Chr(34) & Space(1) & Chr(34) & "+" & Chr(34) & Space(1) & Chr(34) & "M:\Fichiers profils\Nom2" & Chr(34) & Space(1) & Chr(34) & "M:\Fichiers profils\Nom3" & Chr(34)
Shell A$

Et également cela :

Code :

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

1
2
3
Dim A$
A$ = "cmd /c copy  " & Chr(34) & "M:\Fichiers profils\" & Nom1 & Chr(34) & Space(1) & Chr(34) & "+" & Chr(34) & Space(1) & Chr(34) & "M:\Fichiers profils\" & Nom2 & Chr(34) & Space(1) & Chr(34) & "M:\Fichiers profils\" & Nom3 & Chr(34)
Shell A$

Mais aucun des deux ne semble fonctionner.. Peut-être y a-t-il une manière de l'écrire qui m'échappe, quelqu'un saurait-il m'éclairer ?

Dans tous les cas je vous remercie beaucoup de votre aide, je sais que je pourrais me contenter du code de mercatog mais j'aimerais réussir avec mon code aussi

EDIT : pour renommer le nouveau fichier, j'ai fait :

Code :

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

Name "M:\Fichiers profils\Fichier.txt" As "M:\Fichiers profils\" & Nom3

Ca fonctionne mais pour lui dire de ne prendre que les fichiers Nom1 et Nom2, c'est plus délicat :/

[PMO2017]

J'aurais juste une petite question de plus PMO2017 : est-ce que c'est possible de lui faire comprendre de ne prendre en compte que les fichiers .txt que je viens de faire ?

Bonjour,

Copiez le code suivant dans un module standard en adaptant à votre usage la constante cernée par des ###

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
'### Constante à adapter ###
Const DESTINATION As String = "c:\Mes fichiers raboutés.txt"
'###########################
 
Sub RabouterTxt()
Dim mesChoix As Variant
Dim Retour&
Dim i&
Dim A$
Dim CheminDestination$
mesChoix = Application.GetOpenFilename( _
    FileFilter:="Fichiers texte (*.txt), *.txt", _
    Title:="Veuillez sélectionner les fichiers texte à mettre bout à bout", _
    MultiSelect:=True)
If Not IsArray(mesChoix) Then Exit Sub
'---
For i& = LBound(mesChoix) To UBound(mesChoix)
  A$ = A$ & mesChoix(i&) & vbCrLf
Next i&
Retour& = MsgBox(prompt:=A$, Buttons:=vbOKCancel, Title:="Liste des fichiers texte à mettre bout à bout")
If Retour& = vbCancel Then Exit Sub
'---
A$ = ""
For i& = LBound(mesChoix) To UBound(mesChoix)
  A$ = A$ & Chr(34) & mesChoix(i&) & Chr(34) & "+"
Next i&
CheminDestination$ = Chr(34) & DESTINATION & Chr(34)
A$ = "cmd /c copy  " & Mid(A$, 1, Len(A$) - 1) & Space(1) & CheminDestination$
Shell A$
End Sub

Fonctionnement :
1) lancez la procédure "RabouterTxt"
2) sélectionnez les fichiers à rabouter (le MultiSelect étant activé, vous pouvez en sélectionner plusieurs qui sont contenus dans le même dossier)
3) le résultat est dans le chemin/fichier qui a été précisé dans la constante DESTINATION

[Piixx_e]

C'est parfait juste une petite interrogation : est-ce qu'il prend en compte l'ordre alphabétique des fichiers sélectionnés pour les mettre dans l'ordre ? Ou est-ce que par défaut il prend les fichiers dans l'ordre donné par Windows (donc chez moi l'ordre alphabétique des fichiers)
Ce n'est pas important pour moi mais c'est juste pour savoir

Autrement, un grand merci à tous les deux, j'ai beaucoup appris grâce à vous !

Finalement, c'est toujours le code de mercatog qui est le plus rapide (ce coup-là, j'ai bien compris l'avantage des variables tableaux ), alors j'utiliserais celui-ci pour mes fichiers, mais l'autre code me servira peut-être plus tard maintenant qu'il est opérationnel, et pourrait d'ailleurs peut-être servir à d'autres personnes

Encore un énooorme merci, sans vous je n'en aurais pas vu le bout !

[mercatog]

On peut gagner encore 2 petites secondes avec une légère modification. ça te tente?

[Piixx_e]

Yes !

[mercatog]

Au lieu de transférer ligne par ligne le contenu du tableau Res dans notre fichier texte, il suffit de transformer Res en une chaine de caractère à l'aide de Join.
On transfère donc directement le mot obtenu vers le fichier texte.

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
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, Tmp 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") & "2.txt"
 
    '========Modifs ici
    ReDim Preserve Res(1 To k)
    Tmp = Join(Res, vbNewLine)
 
    P = FreeFile
    Open NomFichier For Output As #P
    Print #P, Tmp
    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 & Format((Tb(i, 5) - T0) / 10000 * Multipl, "General Number")
            j = i
        Else
            Passe = False
        End If
    Next i
End With
End Sub