Export Excel=> TXT avec suppression doublon

Export Excel=> TXT avec suppression doublon - VB/VBA/VBS - Programmation

Marsh Posté le 13-04-2017 à 23:31:55    

Bonjour
j'ai fais une petite macro qui fonctionne sous excel (car mes fichiers sources sont en Excel)
elle a pour but de trouver dans une colonne un mot
si ce mot est trouvé alors la valeur d'une autre colonne devra être envoyé dans un fichier TXT
 
http://nsa37.casimages.com/img/2017/04/13/mini_170413114219302500.jpg
 
 
le traitement de 680 000 ligne me prends 25 secondes
cela fonctionne, c'est déjà çà !
 
connaissez vous une méthode plus rapide ?
en VBS, avec des fonctions de dictionnaire, tableau, sans ouvrir le fichier xls
 
 

Code :
  1. Sub export_TXT()
  2. Application.ScreenUpdating = False
  3. Open "c:Text1.txt" For Append As #1
  4. For i = 1 To 1048000
  5. On Error GoTo suivant:
  6. If Range("H" & i) Like "*PORTE*" Then
  7. plan = Left(Range("C" & i), 9)
  8. If plan = dernierplan Then GoTo suivant:
  9. Print #1, plan
  10. dernierplan = plan
  11. End If
  12. suivant:
  13. Next i
  14. Close #1
  15. Application.ScreenUpdating = False
  16. End Sub


pour expliquer le code ci dessus, voila ce que je dirais
For i = 1 To 1048000 => les tables sont assez grosses en général, sans être pleines
append => j'ai plusieurs feuilles a traiter
on error goto suivant => évite les erreurs quand la cellule en comporte une
le teste sur le dernierplan est la pour éviter les doublons

Reply

Marsh Posté le 13-04-2017 à 23:31:55   

Reply

Marsh Posté le 17-04-2017 à 14:58:10    

 
            Bonjour !
 
            Si l'exécution apparaît longue c'est déjà à cause du code !
            Il serait si simple de ne traiter que la plage contenant les données !
            Voir déjà dans l'aide VBA les propriétés  CurrentRegion,  UsedRange,  …
 
            Ensuite Goto est inutile et facteur de ralentissement !
            Et utiliser une boucle est souvent moins rapide que d'utiliser une fonctionnalité interne d'Excel !
 
            Parmi les voies rapides, il y a le filtre avancé d'Excel permettant d'extraire en une seule instruction
            les données souhaitées et sans doublon vers une autre feuille de calculs par exemple …
            Consulter l'aide VBA de la méthode  AdvancedFilter  comme les tutoriels sur la Toile.
 

Reply

Marsh Posté le 17-04-2017 à 15:09:43    

 
            Autre possibilité via la méthode  Range.Find  comme illustrée dans l'aide VBA interne …
 

Reply

Marsh Posté le 17-04-2017 à 15:41:00    

 
            Une démonstration avec  CurrentRegion  &  Find  :
 

Code :
  1. Sub Demo()
  2.         Const D = "D:\Tests4Noobs\"
  3.           Dim Rg As Range, AD$
  4.        If Dir(D, vbDirectory) = "" Then Beep: Exit Sub
  5.    With [A1].CurrentRegion.Columns(8)
  6.           Set Rg = .Find("PORTE ", , xlValues, xlPart)
  7.        If Not Rg Is Nothing Then
  8.          AD = Rg.Address
  9.          Open D & "Text1.txt" For Append As #1
  10.            Do
  11.                If Len(Rg(1, -4).Value) = 9 Then Print #1, Rg(1, -4).Value
  12.                   Set Rg = .FindNext(Rg)
  13.            Loop Until Rg.Address = AD
  14.                   Set Rg = Nothing
  15.          Close #1
  16.        End If
  17.    End With
  18. End Sub


 

Reply

Marsh Posté le 18-04-2017 à 16:04:18    

Bonjour
merci pour le code, mais il semble qu'il y a des problèmes
-il ne tient pas compte des doublons
et surtout, il est encore moins rapide que celui que j'ai donné !
 
ex: 460000 ligne envoyées vers le TXT
45s avec ton code
11s avec celui que j'ai mis en exemple  
 
Finalement le code que j'ai mis au début fera amplement l'affaire

Reply

Marsh Posté le 18-04-2017 à 16:24:35    

Code :
  1. Open "I:Text1.txt" For Append As #1
  2.     For i = 1 To 1000000
  3.      If Range("E" & i) Like "*Porte*" Then Print #1, Left(Range("A" & i), 9)
  4.     Next i
  5. Close #1


épuré au max,il reste rapide et surtout facilement compréhensible
rien qu'en le lisant, je sais dire ce qu'il va faire, et çà, c'est important pour moi

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed