Se connecter avec
S'enregistrer | Connectez-vous
Votre question

Copie lignes sous conditions inputbox

Dernière réponse : dans Programmation
Partagez
3 Mars 2008 14:33:23

BOnjour,

Voici une macro qui me permet de sélectionner les lignes correspondantes à la région parisienne (fonction du numéro département).



J'aimerai pouvoir sélectionner les départements par une msgbox pour sélectionner les départements qui m'intéressent et modifier par la même occasion le nom de la nouvelle feuille...

  1. Sub select()
  2.  
  3. 'déclaration des variables
  4. ' ------------------------
  5. Dim numligne As Long
  6. Dim départ As Integer
  7. Dim numl As Integer
  8. Dim n As Integer
  9.  
  10.  
  11.  
  12.  
  13. ' TRAITEMENT
  14. ' ----------
  15. Application.ScreenUpdating = False
  16. Sheets.Add.Name = "région parisienne"
  17.  
  18. Sheets("Fichier unique Antony").Select
  19. numligne = 2
  20. numl = 2
  21. n = 1
  22. Do
  23. départ = Int(Range("E" & numligne) / 1000)
  24. Select Case départ
  25. Case 2, 8, 10, 14, 18, 21, 22, 27, 28, 29, 35 To 37, 41, 44, 45, 49, 50 To 62, 67, 68, 70, 72, 76, 79 To 80, 85, 86, 88 To 90
  26. ' ne rien effacer
  27. Case Else
  28. Range(numligne & ":" & numligne).Select
  29. x = x + 1
  30. Selection.Copy Sheets("Région parisienne").Range("A" & x)
  31. n = n + 1
  32.  
  33. End Select
  34. numligne = numligne + 1
  35. Loop Until Range("E" & numligne) = ""
  36.  
  37. Application.ScreenUpdating = True
  38.  
  39. derniereLigne = ActiveSheet.UsedRange.Rows.Count
  40. Application.ScreenUpdating = False
  41. For r = derniereLigne To 1 Step -1
  42. If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
  43. Next r
  44.  
  45. Range("A1").End(xlDown).Offset(1, 0).Select
  46.  
  47. End Sub

3 Mars 2008 17:09:20

Quelques remarques sur ce code.
Puisque tu le publies, accepte qu'il soit critiqué. ;) 

NE PAS FAIRE DE SELECT/SELECTION. Tu peux rechercher sur ce site, je le dis systématiquement.
Ce genre de code consomme tellement de ressources que tu as été obligé de faire des ScreenUpdating.

Au lien de faire :
  1. Truc.Select
  2. Selection.Machin
Fais directement :
  1. Truc.Machin
C'est la sélection, le changement de focus, le rafraichissement de tout ça, qui consomment énormément.

x n'est pas défini, ni initialisé !
r n'est pas défini !
numl n'est pas utilisé.

La division entière s'écrit \ :
  1. MsgBox 5 \ 2


Tu utilises une boucle Do .. Loop sans vérifier la première condition.

Tu utilises la collection Sheets. Tu peux être plus précis et utiliser Worksheets.

Tu utilises une énorme condition et tu ne te sers que de l'inverse (Case Else)
Inserve-la ! La région parisienne, c'est 8 départements seulement.


  1. Sub CopieParDepartement(dep As Integer)
  2. ' // Source
  3. Dim cell_src As Range
  4. Dim ws_src As Integer
  5.  
  6. ' // Destination
  7. Dim cell_dst As Range
  8. Dim ws_dst As Integer
  9.  
  10. Set ws_src = Worksheets("Fichier unique Antony")
  11. Set cell_dst = ws_src.Cells(1, 1)
  12.  
  13. Set ws_dst = Worksheets.Add
  14. ws_dst.Name = "Departement " & dep
  15.  
  16. For Each cell_src In Range(ws_src.Range("E2"), ws_src.Range("E2").End(xlDown))
  17. If cell_src.Value \ 1000 = dep Then
  18. cell_src.EntireRow.Copy cell_dst
  19. Set cell_dst = cell_dst.Offset(1)
  20. End If
  21. Next
  22.  
  23. ...
  24.  
  25. End Sub


C'est bon pour un département ça, mais on veut des régions :
  1. Sub CopieParDepartement(deps() As Integer, NomReg As String)
  2. ...
  3. Dim dep As Variant
  4. Dim ok As Boolean
  5. ...
  6. ws_dst.Name = NomReg
  7. ...
  8. For Each cell_src In ..
  9. ok = False
  10. For Each dep In deps
  11. If cell_src.Value \ 1000 = dep Then ok = True
  12. Next
  13. If ok Then
  14. ...


Pour réaliser l'interface, conçois une UserForm, avec la liste des régions.
Fais correspondre chaque item avec des départements :

A toi maintenant de proposer une inferface pour choisir la région :
  1. Option Base 0
  2.  
  3. Dim Reg_IleDeFrance(8) As Integer
  4. Dim Reg_Picardie(3) As Integer
  5.  
  6. Reg_IleDeFrance(0) = 75
  7. Reg_IleDeFrance(1) = 77
  8. Reg_IleDeFrance(2) = 78
  9. Reg_IleDeFrance(3) = 91
  10. Reg_IleDeFrance(4) = 92
  11. Reg_IleDeFrance(5) = 93
  12. Reg_IleDeFrance(6) = 94
  13. Reg_IleDeFrance(7) = 95
  14.  
  15. Reg_Picardie(0) = 2
  16. Reg_Picardie(1) = 60
  17. Reg_Picardie(2) = 80
  18.  
  19. CopieParDepartement Reg_IleDeFrance, "Région Ile de France"



PS: Dans le mesure où ton code fonctionne, je ne te impose pas de le changer, juste d'étudier ce que je propose ;) 
3 Mars 2008 18:33:54

merci, je commençais à désespérer, en fait je ne veux pas les mettre par région, parce que c'est moi qui défini les régions.
C'est pour ça que je veux pouvoir rentrer les départements qui m'intéressent du genre : 22, 56, 29, 44, 49.
Ils ne sont pas dans la même région, mais leur emplacement les mets ensemble.

Je suis administrateur logistique, j'ai un fichier de 1500 clients qui se maintiens (commandes, livraisons), pour faire les tournées des chauffeurs, je choisis des zones, ce qui me permet de ne pas mettre les 1500 clients sur la carte.

Je trouve que inputbox pourrait m'aider et me faire gagner du temps parce que pour le moment, je fais des copier coller dans mon classeur excel.

Pour être honnête, ce n'est pas moi qui est fais la macro, elle m'a été donnée sur un forum.
Je suis nul en vba, en fait je ne sais faire que le plus simple ou adapter celles déjà faites.

E fait, je cherche quelqu'un qui pourrait me la faire... C'est pas très cool mais je n'ai pas les moyens de me pencher dessus pour le moment et surtout pas le temps.
En passant, je cherche des bouquins bien fait pour apprendre.

Merci pour ton aide.
Contenus similaires
3 Mars 2008 23:31:35

Je n'ai pas (plus) de bouquins à te conseiller, mais d'autres peuvent le faire. ;) 

Et surtout ne dit pas trop fort que tu ne cherches qu'à faire faire ton boulot ! C'est très mal vu ici. Si le modo te surprend...

---------------------

Es-tu capable de faire un UserForm ?
C'est plutôt facile.

Les regroupements sont-ils toujours les mêmes ?
Ou toujours différents ?
4 Mars 2008 09:22:36

Merci, je veux bien me lancer à faire la macro, je prendrais le temps.
Juste je voudrais connaitre la manip pour inputbox.
Je voudrais savoir comment je peux rentrer les numéros de départements pour les copier dans une nouvelle feuille.
4 Mars 2008 10:41:54

:) 

Prends le soin de modifier un peu la première procédure :
  1. Sub CopieParDepartement(deps() As String, NomReg As String)
  2. ...
  3. End Sub


Puis regarde un peu ça :
  1. Sub Saisie()
  2. Dim s As String
  3.  
  4. Dim deps() As String
  5. Dim NomReg As String
  6.  
  7. s = InputBox("Veuillez saisir les N° des départements, séparés par des virgules :")
  8. deps = Split(s, ",")
  9.  
  10. s = InputBox("Veuillez saisir un nom pour la nouvelle feuille :")
  11. NomReg = s
  12.  
  13. CopieParDepartement deps, NomReg
  14. End Sub
4 Mars 2008 11:50:26

Voilà ce que j'ai pour le moment, mais ça ne marche pas...
ça bloque sur
  1. Range(numligne & ":" & numligne).Select
  2. x = x + 1
  3. Selection.Copy Sheets("").Range("A" & x)
  4. n = n + 1


  1. Sub test()
  2.  
  3. Dim numligne As Long
  4. Dim depts As Integer
  5. Dim n As Integer
  6. Dim s As String
  7. Dim deps() As String
  8. Dim NomReg As String
  9.  
  10. ' TRAITEMENT
  11. ' ----------
  12. Application.ScreenUpdating = False
  13. Sheets("Feuil1").Select
  14. numligne = 1
  15. n = 1
  16.  
  17.  
  18. depts = Int(Range("E" & numligne) / 1000)
  19.  
  20.  
  21. s = InputBox("Veuillez saisir les N° des départements, séparés par des virgules :")
  22. deps = Split(s, ",")
  23.  
  24. s = InputBox("Veuillez saisir un nom pour la nouvelle feuille :")
  25. NomReg = s
  26.  
  27.  
  28. Range(numligne & ":" & numligne).Select
  29. x = x + 1
  30. Selection.Copy Sheets("").Range("A" & x)
  31. n = n + 1
  32.  
  33.  
  34. numligne = numligne + 1
  35.  
  36.  
  37. End Sub
4 Mars 2008 12:26:19

Après correction, je bloque sur la lignes pour copier dans la nouvelle feuille.

  1. Sub CopieParDepartement(deps() As String, NomReg As String)
  2.  
  3. End Sub
  4.  
  5. Sub saisie()
  6.  
  7. Dim numligne As Long
  8. Dim depts As Integer
  9. Dim n As Integer
  10. Dim s As String
  11. Dim deps() As String
  12. Dim NomReg As String
  13.  
  14. ' TRAITEMENT
  15. ' ----------
  16. Application.ScreenUpdating = False
  17. Sheets("Feuil1").Select
  18. numligne = 1
  19. n = 1
  20.  
  21.  
  22. depts = Int(Range("E" & numligne) / 1000)
  23.  
  24.  
  25. s = InputBox("Veuillez saisir les N° des départements, séparés par des virgules :")
  26. deps = Split(s, ",")
  27.  
  28. s = InputBox("Veuillez saisir un nom pour la nouvelle feuille :")
  29. NomReg = s
  30. CopieParDepartement deps, NomReg
  31.  
  32. Range(s & ":" & s).Copy Sheets(deps).Range("A" & x)
  33.  
  34. n = n + 1
  35.  
  36. numligne = numligne + 1
  37.  
  38.  
  39. End Sub
4 Mars 2008 13:34:21

M'enfin, c'est la fonction CopieParDepartement qui doit copier tes lignes.
4 Mars 2008 13:48:25

C'est bien ce qui me semblait, mais ça marche pas.
La nouvelle feuille ne se crée pas, pas de copie.
4 Mars 2008 14:14:16

J'espère que
  1. Sub CopieParDepartement(deps() As String, NomReg As String)
  2.  
  3. End Sub
n'est pas la totalité du code que tu utilises pour faire cette copie :heink: 
4 Mars 2008 14:23:26

J'ai mis à la suite les deux codes (dans le même module).
J'ai bien les inputbox mais ça ne fait rien.
J'ai dû oublier quelque chose.
4 Mars 2008 15:07:55

Mets un point d'arrêt dans une des macros (touche [F9])
Exécute normalement ta macro. Quand elle s'arrête, appuie sur [F8] pour dérouler ton programme pas-à-pas. Tu verras par où il passe ou ne passe pas.
4 Mars 2008 15:27:39

Je crois que le défaut, c'est que je n'ai pas rempli la macro
Sub CopieParDepartement
Si il y avait quelque chose à y mettre.
5 Mars 2008 11:41:53

Je m'approcherai bien du résultat avec ça, la nouvelle feuille est créée, mais les lignes choisi ne sont pas copier dans cette nouvelle feuille.

  1. Sub saisie()
  2.  
  3. Dim numligne As Long
  4. Dim depts As Integer
  5. Dim n As Integer
  6. Dim s As String
  7. Dim deps() As String
  8. Dim NomReg As String
  9.  
  10. numligne = 1
  11. n = 1
  12.  
  13.  
  14. depts = Int(Range("E" & numligne) / 1000)
  15.  
  16.  
  17. s = InputBox("Veuillez saisir les N° des départements, séparés par des virgules :")
  18. deps = Split(s, ",")
  19.  
  20. s = InputBox("Veuillez saisir un nom pour la nouvelle feuille :")
  21. NomReg = s
  22. CopieParDepartement deps, NomReg
  23.  
  24.  
  25. End Sub
  26.  
  27. Sub CopieParDepartement(deps() As String, NomReg As String)
  28.  
  29. Dim numligne As Long
  30. Dim depts As Integer
  31. Dim n As Integer
  32. Dim s As String
  33.  
  34. Sheets.Add.Name = NomReg
  35.  
  36.  
  37.  
  38.  
  39. Selection.Copy Sheets = NomReg.Range("A" & x)
  40. n = n + 1
  41.  
  42. End Sub