Optimisation Comparer deux colonnes en VBA sous Excel

Optimisation Comparer deux colonnes en VBA sous Excel - VB/VBA/VBS - Programmation

Marsh Posté le 13-12-2007 à 11:19:19    

Bonjour,
 
Voila je doit faire la tache suivante :
 
Comparer les colonnes A de la feuil 1 et feuil 2  
i=numeros de ligne dans la feuil1
x=numeros de ligne dans la feuil2
0<x>5000  
0<i>5000
 
Les colonnes A contiennent des valeur du type "IMB/75103/C/0525"  
 
Si la valeur de cellule Ai dans la feuille 1 et égal à une valeur d'une cellule de la colonne A dans la feuille 2 et si dans la ligne Ax de la feuille 2 la cellule Fx est rempli alors les cellules de la feuille 1 Gx,Hx,Ix ...etc sont egal aux cellule de la feuille 2 Ox,Px..etc  
 
Si Fx est pas rempli ne rien faire  
Si Ax dans feuil1 ne trouve pas de correspondance dans feuil2 passer à i+1.
Stoper la function à i=5000
 
Alors pour le moment je suis parti sur cette piste la

Code :
  1. Sub COMPAR()
  3. 'declaration des variables'
  4. Dim VALEURA As String, i As Integer, x As Integer, valeurB As String
  6. 'i correspondra au numeros de ligne dans la feuille 1'
  7. i = 2
  9. 'continuer tant que i n'est pas egal à 5000'
  10. Do While i <> "5000"
  12. 'donner une valeur de départ à VALEURA, valeura=le contenue de A2'
  13. VALEURA = Range("A" & i).Value
  15. 'activer la feuille 2'
  16. Sheets("Feuil2" ).Select
  18. 'x correspond au numeros de ligne dans la feuille 2'
  19. x = 2
  21. 'donner une valeur de depart a valeurb'
  22. valeurB = Range("A" & x).Value
  24. 'comparer valeura et valeurb, tant que faux incrementer x de 1'
  25. Do While VALEURA <> valeurB
  26. x = x + 1
  27. valeurB = Range("A" & x).Value
  28. Loop
  31. 'si la cellule Lx = quelque chose alors on copy la ligne'
  32. If Range("L" & x).Value <> "" Then
  33. Range("L" & x).Select
  34. Selection.Copy
  35. Sheets("Feuil1" ).Select
  36. Range("J" & i).Select
  37. ActiveSheet.Paste
  38. Sheets("Feuil2" ).Select
  39. Range("O" & x).Select
  40. Selection.Copy
  41. Sheets("Feuil1" ).Select
  42. Range("M" & i).Select
  43. ActiveSheet.Paste
  44. End If
  46. 'on incremente i de 1'
  47. i = i + 1
  49. 'on continue les fonction d'avant jusqu'a ce que i=5000'
  50. Loop
  52. End Sub


 
J'ai un probléme a la ligne 26  X ne s'arrete jamais d'incrementer hors il faut que je larréte à 5000 si il n'a pas trouver de correspondance.
 
Merci.
 
Viouu


Message édité par Viouu le 13-12-2007 à 12:25:05
Reply

Marsh Posté le 13-12-2007 à 11:19:19   

Reply

Marsh Posté le 13-12-2007 à 12:26:21    

Bon ok tout marche maintenant mais je shouaterai l'optimisé car ca prend bcp bcp de temps ..
 

Code :
  1. Sub COMPAR()
  3. 'declaration des variables'
  4. Dim VALEURA As String, i As Integer, x As Integer, valeurB As String
  6. 'i correspondra au numeros de ligne dans la feuille 1'
  7. i = 2
  9. 'continuer tant que i n'est pas egal à 5000'
  10. Do While i <> "5000"
  12. 'donner une valeur de départ à VALEURA, valeura=le contenue de A2'
  13. VALEURA = Range("A" & i).Value
  15. 'activer la feuille 2'
  16. Sheets("Feuil2" ).Select
  18. 'x correspond au numeros de ligne dans la feuille 2'
  19. x = 2
  21. 'donner une valeur de depart a valeurb'
  22. valeurB = Range("A" & x).Value
  24. 'comparer valeura et valeurb, tant que faux incrementer x de 1'
  26. Do While VALEURA <> valeurB
  27. x = x + 1
  28. If x = 5000 Then GoTo l49
  29. valeurB = Range("A" & x).Value
  30. Loop
  33. 'si la cellule Lx = quelque chose alors on copy la ligne'
  34. If Range("L" & x).Value <> "" Then
  35. Range("L" & x).Select
  36. Selection.Copy
  37. Sheets("Feuil1" ).Select
  38. Range("J" & i).Select
  39. ActiveSheet.Paste
  40. Sheets("Feuil2" ).Select
  41. Range("O" & x).Select
  42. Selection.Copy
  43. Sheets("Feuil1" ).Select
  44. Range("M" & i).Select
  45. ActiveSheet.Paste
  46. End If
  48. 'on incremente i de 1'
  49. l49:
  50. i = i + 1
  52. 'on continue les fonction d'avant jusqu'a ce que i=5000'
  53. Loop
  55. End Sub


 
Quelqu'un à une idée
 
Viouu

Reply

Marsh Posté le 13-12-2007 à 12:48:16    

VBA n'est pas très rapide.
 
Pour accélérer un petit peu, on peut supprimer le refresh et l'auto update avec

Application.ScreenUpdating = False
...
Tout le programme
...
Application.ScreenUpdating = True

Reply

Marsh Posté le 13-12-2007 à 12:53:39    

merci je vais essayer
 
Je me posait la question vue qu'il fait du copier coller il ne faut pas vider le presse papier ?
 
Viouu

Reply

Marsh Posté le 13-12-2007 à 13:15:56    

Application.ScreenUpdating n'interfère pas avec le presse papier.

Reply

Marsh Posté le 13-12-2007 à 13:26:39    

Je sais mais vue que j'utilise le copier coller dans mon code. ?
 
Viouu

Reply

Sujets relatifs:

Leave a Replay

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