Pas de soucis merci beaucoup par avance
Pas de soucis merci beaucoup par avance
Un énorme merci tout cela fonctionne à merveille dans le fichier test, je regarde dans le gros fichier si cela ne pose pas de soucis majeur.
Je reviens vers toi si problème.
Encore merci
David
re
ca ne devrait pas faillir c'est une routine répétitive qui ne fait rien si il y a pas lieu
ca ne devrait pas causer de soucis mémoire non plus puisque je lis ligne par ligne et réécrit personne par personne
au pire la variable texte contient la personne qui contient le plus de ligne et revient a une ligne(*INDI*) a chaque nouvelle personne
dataline contient une seule ligne du fichier texte a chaque tour jusqu'à EOF
après voir pour un fichier 3 million de ligne combien de temps ca va prendre c'est tout mais en aucun cas ca devrait surcharger sauf erreur de ma part
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
Re,
effectivement pas de problème de mémoire, ni de surcharge du processeur, le fichier est en cours de traitement depuis plus de trente minutes, mais compte tenu du nombre de ligne cela ne m'étonne pas.
Merci encore
re
combien de mega fait il ce fichier?
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
Re bonsoir,
63.1Mo mais ça y est au bout d'une bonne heure le fichier est traité sans erreur.
Travail nickel, merci beaucoup Patrick,
Très bonne soirée
je vais étudier un autre principe pour voir si on peu gagner du temps j'ai vu des fichier plus lourd que ca
bien que des .txt de 60 mega c'est un peu lourd quand même
il sont produits comment ces fichiers text?
je me demande si je pourraits pas ouvrir les deux en même temps sans ouverture et fermetures intermédiaires entre chaque personne
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
Re,
ces fichiers txt ne le sont pas vraiment puisque ce sont à la base des fichiers de type Gedcom (extension .ged) créés par des logiciels de généalogies pour permettre l'échange de fichiers entre les utilisateurs.
Mais cette extension est totalement lisible sous n'importe qu'elle logiciel de traitement de fichier txt (notepad, ultraedit...). Il me suffit de modifier la balise ged par txt et le tour est joué.
Merci de ton aide bien précieuse
re
essaie ce mode(sans open/close intermediaire du new 2
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 Sub AllInOne() ' ligne par ligneavec input simple Dim x As Integer, f As Integer, DataLine$, texte$, ligneNPFX$, lignesex$, fichier$, fichier2$ fichier = "C:\Users\polux\DeskTop\new 1.txt" 'adapte ton lien ici fichier2 = "C:\Users\polux\DeskTop\new 2.txt" 'adapte ton lien ici If Dir(fichier2) <> "" Then Kill fichier2 x = FreeFile Open fichier For Input As #x f = FreeFile If Dir(fichier2) = "" Then Open fichier2 For Output As #f Else Open fichier2 For Append As #f End If While Not EOF(x) Line Input #x, DataLine 'lecture de la ligne If DataLine Like "*INDI" Then If texte <> "" Then If ligneNPFX <> "" Then texte = Replace(texte, lignesex, ligneNPFX & vbCrLf & lignesex) For i = 1 To 3: texte = Replace(texte, vbCrLf & vbCrLf, vbCrLf): Next Print #f, texte End If texte = DataLine ligneNPFX = "" lignesex = "" Else If DataLine Like "1 SEX*" Then lignesex = DataLine If DataLine Like "1 NPFX*" Then ligneNPFX = DataLine: DataLine = "" If DataLine Like "1 NSFX*" Then ligneNPFX = ligneNPFX & vbCrLf & DataLine: DataLine = "" If DataLine Like "1 NICK*" Then ligneNPFX = ligneNPFX & vbCrLf & DataLine: DataLine = "" texte = texte & vbCrLf & DataLine End If Wend Close #x Close #f End Sub
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
Bonsoir,
ça marche avec rapidité (moins de 1mn) mais parce que je supprime tout un bloc de ligne qui se trouve à la fin du fichier et qui ne comporte plus de balise de départ du type 0 @I1@ INDI
C'est le dernier bloc qui débute par 0 @F1@ FAM qui fait "ramer" le script.
Existe t'il un moyen de stopper la macro dès l'arrivée à la ligne comportant 0 @F1@ FAM ??
Merci
Si besoin voici un fichier avec l'incorporation de ce bloc.
new 1.txt
re
si il y a 1 seul " 0 @F1@ FAM ??" oui
sinon on perdra plus de temps qu' a en gagner a essayer de splitter la partie du texte valide
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
je confirme qu'il n'y a qu'un seul 0 @F1@ FAM
mais si cela est trop compliqué il est tout aussi rapide de couper et recoller après traitement.
Tu m'as déjà rendu un fier service, cela faisait des semaines que je ne savait plus comment faire
ok si il y en a qu'un
on passe en do while
et on fait un exit do arrivé acette ligne
et le tour est joué
ca devrait un peu t'accélérer le smilblick
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 Sub AllInOne() ' ligne par ligneavec input simple Dim x As Integer, f As Integer, DataLine$, texte$, ligneNPFX$, lignesex$, fichier$, fichier2$ fichier = "C:\Users\polux\DeskTop\new 1.txt" 'adapte ton lien ici fichier2 = "C:\Users\polux\DeskTop\new 2.txt" 'adapte ton lien ici If Dir(fichier2) <> "" Then Kill fichier2 x = FreeFile Open fichier For Input As #x f = FreeFile If Dir(fichier2) = "" Then Open fichier2 For Output As #f Else Open fichier2 For Append As #f End If Do While Not EOF(x) Line Input #x, DataLine 'lecture de la ligne If DataLine = "0 @F1@ FAM ??" Then Exit Do'!!! ici on sort de la boucle si lignes trouvée If DataLine Like "*INDI" Then If texte <> "" Then If ligneNPFX <> "" Then texte = Replace(texte, lignesex, ligneNPFX & vbCrLf & lignesex) For i = 1 To 3: texte = Replace(texte, vbCrLf & vbCrLf, vbCrLf): Next Print #f, texte End If texte = DataLine ligneNPFX = "" lignesex = "" Else If DataLine Like "1 SEX*" Then lignesex = DataLine If DataLine Like "1 NPFX*" Then ligneNPFX = DataLine: DataLine = "" If DataLine Like "1 NSFX*" Then ligneNPFX = ligneNPFX & vbCrLf & DataLine: DataLine = "" If DataLine Like "1 NICK*" Then ligneNPFX = ligneNPFX & vbCrLf & DataLine: DataLine = "" texte = texte & vbCrLf & DataLine End If Loop Close #x Close #f End Sub
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
Bonsoir Patrick,
donc je te confirme que cela marche bien, j'ai fait néanmoins une petite correction à ton code en retirant les ?? après "0 @F1@ FAM" que je t'avais indiqué par erreur.
En revanche, dans le fichier source ici news 2, le texte qui suit la ligne 0 @F1@ FAM n'est plus reproduit ce qui m’oblige à couper et recoller le bloc manquant. Sincèrement rien de bien méchant qui peut se réalise manuellement en 2 secondes.
sauf si bien entendu tu as une solution rapide.
Peux tu me permettre une petite question, est-il possible d'utiliser ton script pour insérer de nouvelles macro du type rechercher/remplacer ? toujours sans ouvrir le fichier dans Excel.
Encore merci pour tout.
David
essaie celle la
normalement elle t"ecrit toute la personne mais s'arrête âpres si je ne me trompe pas
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 Sub AllInOne() ' ligne par ligneavec input simple Dim x As Integer, f As Integer, DataLine$, texte$, ligneNPFX$, lignesex$, fichier$, fichier2$, arrete As Boolean fichier = "C:\Users\polux\DeskTop\new 1.txt" 'adapte ton lien ici fichier2 = "C:\Users\polux\DeskTop\new 2.txt" 'adapte ton lien ici If Dir(fichier2) <> "" Then Kill fichier2 x = FreeFile Open fichier For Input As #x f = FreeFile If Dir(fichier2) = "" Then Open fichier2 For Output As #f Else Open fichier2 For Append As #f End If Do While Not EOF(x) Line Input #x, DataLine 'lecture de la ligne If DataLine Like "*INDI" And arrete = False Then If texte <> "" Then If ligneNPFX <> "" Then texte = Replace(texte, lignesex, ligneNPFX & vbCrLf & lignesex) For i = 1 To 3: texte = Replace(texte, vbCrLf & vbCrLf, vbCrLf): Next Print #f, texte End If texte = DataLine ligneNPFX = "" lignesex = "" Else If DataLine Like "1 SEX*" Then lignesex = DataLine If DataLine Like "1 NPFX*" Then ligneNPFX = DataLine: DataLine = "" If DataLine Like "1 NSFX*" Then ligneNPFX = ligneNPFX & vbCrLf & DataLine: DataLine = "" If DataLine Like "1 NICK*" Then ligneNPFX = ligneNPFX & vbCrLf & DataLine: DataLine = "" If DataLine = "0 @F1@ FAM" Then arrete = True texte = texte & vbCrLf & DataLine End If Loop Close #x Close #f End Suboui bien sur de la même manière que je faitPeux tu me permettre une petite question, est-il possible d'utiliser ton script pour insérer de nouvelles macro du type rechercher/remplacer ? toujours sans ouvrir le fichier dans Excel.
Encore merci pour tout.
David
tu peux même faire des fonctions séparées
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
Re,
merci pour ta réponse, malheureusement avec le nouveau code je retrouve le délais de traitement très long comme le premier code que tu m'avais fourni.
re
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 Sub AllInOne() ' ligne par ligneavec input simple Dim x As Integer, f As Integer, DataLine$, texte$, ligneNPFX$, lignesex$, fichier$, fichier2$, arrete As Boolean fichier = "C:\Users\polux\DeskTop\new 1.txt" 'adapte ton lien ici fichier2 = "C:\Users\polux\DeskTop\new 2.txt" 'adapte ton lien ici If Dir(fichier2) <> "" Then Kill fichier2 x = FreeFile Open fichier For Input As #x f = FreeFile If Dir(fichier2) = "" Then Open fichier2 For Output As #f Else Open fichier2 For Append As #f End If Do While Not EOF(x) Line Input #x, DataLine 'lecture de la ligne 'essaie avec ca : If arrete = True Then Exit Do ' ou ca 'If arrete = True Then Print #f, texte: Exit Do If DataLine Like "*INDI" And arrete = False Then If texte <> "" Then If ligneNPFX <> "" Then texte = Replace(texte, lignesex, ligneNPFX & vbCrLf & lignesex) For i = 1 To 3: texte = Replace(texte, vbCrLf & vbCrLf, vbCrLf): Next Print #f, texte End If texte = DataLine ligneNPFX = "" lignesex = "" Else If DataLine Like "1 SEX*" Then lignesex = DataLine If DataLine Like "1 NPFX*" Then ligneNPFX = DataLine: DataLine = "" If DataLine Like "1 NSFX*" Then ligneNPFX = ligneNPFX & vbCrLf & DataLine: DataLine = "" If DataLine Like "1 NICK*" Then ligneNPFX = ligneNPFX & vbCrLf & DataLine: DataLine = "" If DataLine = "0 @F1@ FAM" Then arrete = True texte = texte & vbCrLf & DataLine End If Loop Close #x Close #f End Sub
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
Re,
vraiment navré, mais la vitesse est revenu sauf que le texte n'est plus copié
tu a essayé avec une ligne ou l'autre????
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager