Recherche dans des feuilles de données

Recherche dans des feuilles de données - VB/VBA/VBS - Programmation

Marsh Posté le 18-05-2016 à 16:00:13    

Bonjour,  
Je me suis crée un petit programme excel pour me rechercher des données en fonction de la cellule choisie je voudrai qu'il me remplisse les colonnes ou apparaissent Ca et Cs.  
Le problème c'est que mon fichier le fait mais il est trop lent (j'ai l'impression qu'il perd du temps).  
A la première itération il remplit toutes les lignes , alors que je voudrais qu'il remplisse juste chaque ligne en fonction du paramètre donné dans microwave.  
Or pour le moment il voit le premier paramètre et va remplir toutes les cases du tableau.  
En gros B1 correspond à P ou FP  
B2 à P/FP  
B3 à HP/UHX  
B4 à GP ou KP  
B5 et B6 ne sont pas utilisés  
 
En gros chaque degré donne une valeur de Ca et Cs lu dans une des feuilles Excel.  
Le programme fait déjà ce que je veux faire mais il est lent j ai l impression de faire des boucles inutiles.  
 
En gros il faudrait que le programme ne remplisse que les colonnes O,P,S,T,Y,Z,AD,AE,AI,AJ,AN,AO , il a parfois tendence a remplir d'autres colonnes et à effacer mes formules .  
Est ce que quelqu'un pourrait m'envoyer une version améliorée de ce que je demande ?  
 
Merci.  

Code :
  1. Sub Macro1()
  2. Dim cel As Range 'déclare la variable cel (CELlule)
  3. Dim Ca1 As Range 'déclare la variable Ca (Recherche
  4. Dim Cs1 As Range 'déclare la variable Ca (Recherche
  5. Dim Ca2 As Range 'déclare la variable Ca (Recherche
  6. Dim Cs2 As Range 'déclare la variable Ca (Recherche
  7. Dim i As Integer
  8. Dim f As Integer
  11. With Sheets("MO" ) 'prend en compte l'onglet "AVANT" (à adapter à ton cas)
  12. 'boucle sur toutes les cellules éditées cel de la colonne A (en partant de la ligne 2)
  13. f = Range("K2" ).Value
  14. For i = 16 To 16 + f
  16. For Each cel In .Range("N" & i & ":AM" & i & .Cells(Application.Rows.Count, 1).End(xlUp).Row)
  17. 'définit la recherche r (recherche la valeur de la cellule en partie dans la colonne A de l'onglet "BASE" )
  18. If Range("B" & i).Value Like "P ou FP" Then
  19. Set Ca1 = Sheets("B1" ).Columns(1).Find(cel.Value, , xlValues, xlPart)
  20. Set Cs1 = Sheets("B1" ).Columns(1).Find(cel.Value, , xlValues, xlPart)
  22. 'si il existe au moins une occurrence trouvée, place dals la colonne I de cel la valeur de la colonne C de r
  23. If Not Ca1 Is Nothing Then cel.Offset(0, 1).Value = Ca1.Offset(0, 1).Value
  24. If Not Cs1 Is Nothing Then cel.Offset(0, 2).Value = Cs1.Offset(0, 2).Value
  25. Else
  26. If Range("B" & i).Value Like "P/FP" Then
  27. Set Ca1 = Sheets("B2" ).Columns(1).Find(cel.Value, , xlValues, xlPart)
  28. Set Cs1 = Sheets("B2" ).Columns(1).Find(cel.Value, , xlValues, xlPart)
  30. 'si il existe au moins une occurrence trouvée, place dals la colonne I de cel la valeur de la colonne C de r
  31. If Not Ca1 Is Nothing Then cel.Offset(0, 1).Value = Ca1.Offset(0, 1).Value
  32. If Not Cs1 Is Nothing Then cel.Offset(0, 2).Value = Cs1.Offset(0, 2).Value
  33. Else
  34. If Range("B" & i).Value Like "HP/UHX" Then
  35. Set Ca1 = Sheets("B3" ).Columns(1).Find(cel.Value, , xlValues, xlPart)
  36. Set Cs1 = Sheets("B3" ).Columns(1).Find(cel.Value, , xlValues, xlPart)
  38. 'si il existe au moins une occurrence trouvée, place dals la colonne I de cel la valeur de la colonne C de r
  39. If Not Ca1 Is Nothing Then cel.Offset(0, 1).Value = Ca1.Offset(0, 1).Value
  40. If Not Cs1 Is Nothing Then cel.Offset(0, 2).Value = Cs1.Offset(0, 2).Value
  41. Else
  42. If Range("B" & i).Value Like "GP ou KP" Then
  43. Set Ca1 = Sheets("B4" ).Columns(1).Find(cel.Value, , xlValues, xlPart)
  44. Set Cs1 = Sheets("B4" ).Columns(1).Find(cel.Value, , xlValues, xlPart)
  46. 'si il existe au moins une occurrence trouvée, place dals la colonne I de cel la valeur de la colonne C de r
  47. If Not Ca1 Is Nothing Then cel.Offset(0, 1).Value = Ca1.Offset(0, 1).Value
  48. If Not Cs1 Is Nothing Then cel.Offset(0, 2).Value = Cs1.Offset(0, 2).Value
  49. Else
  50. If Range("B" & i).Value Like "*B5*" Then
  51. Set Ca1 = Sheets("B5" ).Columns(1).Find(cel.Value, , xlValues, xlPart)
  52. Set Cs1 = Sheets("B5" ).Columns(1).Find(cel.Value, , xlValues, xlPart)
  54. 'si il existe au moins une occurrence trouvée, place dals la colonne I de cel la valeur de la colonne C de r
  55. If Not Ca1 Is Nothing Then cel.Offset(0, 1).Value = Ca1.Offset(0, 1).Value
  56. If Not Cs1 Is Nothing Then cel.Offset(0, 2).Value = Cs1.Offset(0, 2).Value
  57. Else
  58. If Range("B" & i).Value Like "*B6*" Then
  59. Set Ca1 = Sheets("B6" ).Columns(1).Find(cel.Value, , xlValues, xlPart)
  60. Set Cs1 = Sheets("B6" ).Columns(1).Find(cel.Value, , xlValues, xlPart)
  62. 'si il existe au moins une occurrence trouvée, place dals la colonne I de cel la valeur de la colonne C de r
  63. If Not Ca1 Is Nothing Then cel.Offset(0, 1).Value = Ca1.Offset(0, 1).Value
  64. If Not Cs1 Is Nothing Then cel.Offset(0, 2).Value = Cs1.Offset(0, 2).Value
  65. End If
  66. End If
  67. End If
  68. End If
  69. End If
  70. End If
  71. Next cel 'prochaine cellule de la boucle
  72. Next
  74. End With 'fin de la prise en compte de l'onglet "AVANT"
  77. End Sub

Reply

Marsh Posté le 18-05-2016 à 16:00:13   

Reply

Marsh Posté le 28-05-2016 à 18:38:01    

Bonjour fakry
 
Joli code qui réinvente le SQL :pt1cable:  ... alors conseil d'ami, migre sur base de données à minima  Access car ton code en SQL, c'est rien à faire et en plus tu as des requêteur visuel, pas besoin de coder  :bounce:


Message édité par informer le 28-05-2016 à 18:38:48
Reply

Sujets relatifs:

Leave a Replay

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