champs de saisie qu permet d'isoler une ligne

champs de saisie qu permet d'isoler une ligne - VB/VBA/VBS - Programmation

Marsh Posté le 06-07-2017 à 15:57:23    

Bonjour !!  
 
 J'ai vraiment besoin de votre aide  
 Je voudrais qua partir d'un champs de saisi je saisie "C4" et la macro me sélectionne toute la ligne contenant "c4" et la met dans une feuille a part du même fichier Excel  
 Merci a tous  
 
 


---------------
elio
Reply

Marsh Posté le 06-07-2017 à 15:57:23   

Reply

Marsh Posté le 07-07-2017 à 21:32:40    

J'enfrein un peu la règle [0C] mais bon c'etait rapide.
 
Je ne comprends pas pourquoi tu veux entrer l'adresse d'une cellule pour déplacer une ligne complete alors que juste demander la ligne suffi.
J'ai fait le bout de code en fonction de ca.
Je dis pas que c'est la meilleur méthode mais ça fait le job
 

Code :
  1. Sub DeplaceLigne()
  3. 'déclaration des variables
  4. Dim ligne As String
  5. Dim feuil1 As String
  6. Dim feuil2 As String
  8. 'Boite de dialogue demandant la ligne à déplacer
  9. ligne = InputBox("Veuillez entrez le numéro de ligne à copier", "?" )
  11. 'Stocke le nom de la feuille de départ
  12. feuil1 = ActiveSheet.Name
  14. 'Créé une nouvelle feuille et stocke son nom
  15. Sheets.Add
  16. feuil2 = ActiveSheet.Name
  18. 'Copie la ligne dans la nouvelle feuille
  19. Sheets(feuil1).Range(ligne & ":" & ligne).Copy Sheets(feuil2).Range("A1" )
  20. 'Supprime la ligne dans la feuille de départ
  21. Sheets(feuil1).Range(ligne & ":" & ligne).Delete Shift:=xlUp
  23. 'reselectionne la feuille de départ
  24. Sheets(feuil1).Select
  26. End Sub


 
 
Edit:
Bon je pense pas que ca me resservira mais j'ai trouvé intéressant d'essayer exactement ce que tu veux, c'est à dire entrer une adresse de cellule et déplacer toute la ligne dans une nouvelle feuille.
 

Code :
  1. Sub DeplaceLigne2()
  3. 'déclaration des variables
  4. Dim ligne As String
  5. Dim Cellule As String
  6. Dim feuil1 As String
  7. Dim Feuil2 As String
  9. 'Boite de dialogue demandant la cellule dont la ligne est à déplacer
  10. Cellule = InputBox("Veuillez entrez l'adresse de la cellule dont la ligne est à déplacer", "?" )
  11. ligne = Range(Cellule).Row
  13. 'Stocke le nom de la feuille de départ
  14. feuil1 = ActiveSheet.Name
  15. 'Créé une nouvelle feuille et stocke son nom
  16. Sheets.Add
  17. Feuil2 = ActiveSheet.Name
  19. 'Copie la ligne dans la nouvelle feuille
  20. Sheets(feuil1).Range(ligne & ":" & ligne).Copy Sheets(Feuil2).Range("A1" )
  21. Sheets(feuil1).Range(ligne & ":" & ligne).Delete Shift:=xlUp
  23. 'reselectionne la feuille de départ
  24. Sheets(feuil1).Select
  26. End Sub


Message édité par wago le 07-07-2017 à 23:30:20
Reply

Marsh Posté le 10-07-2017 à 10:48:51    

Bonjour WAGO,
 
Je suis impressionner tu es la 1ere personne a avoir réussi a faire merciiii beaucoup, cependant c'est une erreur de ma part d'avoir mal expliquer au lieu de donner la ligne ou le nom de la cellule je voudrai saisir le champs de la cellule c'est la raison pour laquelle j'ai dit c4 (c la valeur que contient la cellule H5) et ainsi je devrais avoir plusieurs résultat pour c4 . Mais d'avance je ne peux pas connaitre ni la ligne ni le nom de la cellule dont je cherche le champs  
Désolé surtout que tu t'es vraiment pencher sur mon problème
as tu compris ce que je voudrais ?

Reply

Marsh Posté le 26-07-2017 à 22:15:20    

Salut,
 
Désolé du délais de réponse j'ai été pas mal occupé au taf.
 
La valeur cherchée est-elle toujours dans la même colonne?
 
ex ici "C4" est tjs en colonne A:
 
     A    B   C    D   E
1  C4  H3  D3  C5  D8...
2  H3  D3  C5  D8  E2...
3  H3  D3  C5  D8  D1...
4  C4  H3  D3  C5  D8...
...
 
Par ce que là une simple boucle sur les valeurs de A et le tour est joué.
Si non il faut une boucle qui cherche cellule par cellule, ça peut être long en fonction de la plage à traiter.
 

Reply

Marsh Posté le 27-07-2017 à 10:26:34    

Ne tkt pas je comprend que tu sois occuper et je te remercie de me répondre
Effectivement il s'agit d'un élément C4 qui n'est pas toujours dans la même colonne

Message cité 1 fois
Reply

Marsh Posté le 27-07-2017 à 16:32:18    

elio55 a écrit :

Ne tkt pas je comprend que tu sois occuper et je te remercie de me répondre
Effectivement il s'agit d'un élément C4 qui n'est pas toujours dans la même colonne


 
Essaye ca, chez moi ça fonctionne:

Code :
  1. Sub CopieLigne()
  2. 'déclaration des variables
  3. Dim Cherche As String
  4. Dim NbLigne As Integer
  5. Dim NbColonne As Integer
  6. Dim Feuille As String
  7. Dim I As Integer
  8. Dim J As Integer
  9. Dim dernlignetab As String
  11. 'Initialisation des varibles "Fixes"
  12. Feuille = ActiveSheet.Name
  13. NbLigne = Application.WorksheetFunction.CountA(Worksheets(Feuille).Range("$A:$A" ))
  14. NbColonne = Application.WorksheetFunction.CountA(Worksheets(Feuille).Range("$1:$1" ))
  16. 'Boite de dialogue demandant la valeur de cellule dont la ligne est à déplacer
  17. Cherche = InputBox("Veuillez entrez le texte recherché", "?" )
  19. 'Boucle sur les lignes
  20. For I = 2 To NbLigne
  21.     'Boucle sur les colonnes
  22.     For J = 1 To NbColonne
  23.         'teste la présence de la feuille, si non la créé
  24.         If Sheets(Feuille).Cells(I, J) = Cherche Then
  25.             If WsExist(Cherche) = True Then
  26.                 'determine la dernière ligne du tableau pour copier la ligne
  27.                 dernilgnetab = Sheets(Cherche).Range("A" & Rows.Count).End(xlUp).Row + 1
  28.                 'Copie la ligne
  29.                 Sheets(Feuille).Range(I & ":" & I).Copy Sheets(Cherche).Range("A" & dernilgnetab)
  30.                 GoTo FINJ
  31.             Else
  32.                 'Ajoute une feuille
  33.                 Sheets.Add
  34.                 'La nomme avec la valeur cherchée
  35.                 ActiveSheet.Name = Cherche
  36.                 'Copie l'entete des colonnes
  37.                 Sheets(Feuille).Range("1:1" ).Copy Sheets(Cherche).Range("A1" )
  38.                 'Copie la ligne
  39.                 Sheets(Feuille).Range(I & ":" & I).Copy Sheets(Cherche).Range("A2" )
  40.                 GoTo FINJ
  41.             End If
  42.          End If
  43.     Next J
  44. FINJ:
  45. Next I
  47. MsgBox ("FIN" )
  49. End Sub
  50. Function WsExist(Nom$) As Boolean
  51. On Error Resume Next
  52. WsExist = Sheets(Nom).Index
  53. End Function


 
Ça copie la ligne, ça ne la supprime pas du tableau initial
Ca créé une feuille au nom de la valeur cherchée
Pour que ca marche bien la colonne A ne doit pas avoir d'espace vide, la ligne 1 non plus.
 

Reply

Marsh Posté le 27-07-2017 à 19:20:40    

J'ai ajouté 2lignes dans le code qui met la cellule ayant été détectée et générant le déplacement et JAUNE.
Le code modifié:
 

Code :
  1. Sub CopieLigne()
  2. 'déclaration des variables
  3. Dim Cherche As String
  4. Dim NbLigne As Integer
  5. Dim NbColonne As Integer
  6. Dim Feuille As String
  7. Dim I As Integer
  8. Dim J As Integer
  9. Dim dernlignetab As String
  11. 'Initialisation des varibles "Fixes"
  12. Feuille = ActiveSheet.Name
  13. NbLigne = Application.WorksheetFunction.CountA(Worksheets(Feuille).Range("$A:$A" ))
  14. NbColonne = Application.WorksheetFunction.CountA(Worksheets(Feuille).Range("$1:$1" ))
  16. 'Boite de dialogue demandant la valeur de cellule dont la ligne est à déplacer
  17. Cherche = InputBox("Veuillez entrez le texte recherché", "?" )
  19. 'Boucle sur les lignes
  20. For I = 2 To NbLigne
  21.     'Boucle sur les colonnes
  22.     For J = 1 To NbColonne
  23.         'teste la présence de la feuille, si non la créé
  24.         If Sheets(Feuille).Cells(I, J) = Cherche Then
  25.             If WsExist(Cherche) = True Then
  26.                 'determine la dernière ligne du tableau pour copier la ligne
  27.                 dernilgnetab = Sheets(Cherche).Range("A" & Rows.Count).End(xlUp).Row + 1
  28.                 'Copie la ligne
  29.                 Sheets(Feuille).Range(I & ":" & I).Copy Sheets(Cherche).Range("A" & dernilgnetab)
  30.                 'Met en surbrillance la valeur ayant généré le déplacement
  31.                 Sheets(Cherche).Cells(dernilgnetab, J).Interior.ColorIndex = 6
  32.                 GoTo FINJ
  33.             Else
  34.                 'Ajoute une feuille
  35.                 Sheets.Add
  36.                 'La nomme avec la valeur cherchée
  37.                 ActiveSheet.Name = Cherche
  38.                 'Copie l'entete des colonnes
  39.                 Sheets(Feuille).Range("1:1" ).Copy Sheets(Cherche).Range("A1" )
  40.                 'Copie la ligne
  41.                 Sheets(Feuille).Range(I & ":" & I).Copy Sheets(Cherche).Range("A2" )
  42.                 Sheets(Cherche).Cells(2, J).Interior.ColorIndex = 6
  43.                 GoTo FINJ
  44.             End If
  45.          End If
  46.     Next J
  47. FINJ:
  48. Next I
  50. MsgBox ("FIN" )
  52. End Sub
  53. Function WsExist(Nom$) As Boolean
  54. On Error Resume Next
  55. WsExist = Sheets(Nom).Index
  56. End Function

Reply

Marsh Posté le 28-07-2017 à 10:46:42    

Bonjour Wago déjà je te remercie sincèrement d'avoir passer du temps sur ma macro c'est super gentils  
Je n'arrive pas à l'exécuter je vois bien le champs de saisie mais quand je saisi "c4" elle me met un message "fin" mais aucune ligne n'a été copier dans une autre feuille

Reply

Marsh Posté le 28-07-2017 à 10:48:43    

saurais tu comment faire pour envoyer une pièce jointe ?

Reply

Marsh Posté le 28-07-2017 à 13:08:18    

Ça fait ça parce qu'il n'à pas trouvé de c4.
Peut être qu'il y a un espace ou autre chose.

Reply

Marsh Posté le 28-07-2017 à 13:08:18   

Reply

Marsh Posté le 29-07-2017 à 10:18:54    

J'ai modifié un peu le code, celui ci cherche dans la chaîne de caractère contenu dans la cellule.
Si tu cherche C4 dans "DERTFGC4", il te copiera la ligne parce qu'il y a C4.
Par contre su tu cherche C4 dans la chaine "FDJFKDCB4", même s'il y a un C et un 4 il trouvera pas parce que espacé d'un caractère
 

Code :
  1. Sub DeplaceLigne2()
  2. 'déclaration des variables
  3. Dim Cherche As String
  4. Dim NbLigne As Integer
  5. Dim NbColonne As Integer
  6. Dim Feuille As String
  7. Dim I As Integer
  8. Dim J As Integer
  9. Dim dernlignetab As String
  10. Dim Z As Integer
  12. 'Initialisation des varibles "Fixes"
  13. Feuille = ActiveSheet.Name
  14. NbLigne = Application.WorksheetFunction.CountA(Worksheets(Feuille).Range("$A:$A" ))
  15. NbColonne = Application.WorksheetFunction.CountA(Worksheets(Feuille).Range("$1:$1" ))
  16. Z = 0
  18. 'Boite de dialogue demandant la valeur de cellule dont la ligne est à déplacer
  19. Cherche = InputBox("Veuillez entrez le texte recherché", "?" )
  21. 'Boucle sur les lignes
  22. For I = 2 To NbLigne
  23.     'Boucle sur les colonnes
  24.     For J = 1 To NbColonne
  25.         'teste la présence de la feuille, si non la créé
  26.         If InStr(Sheets(Feuille).Cells(I, J), Cherche) > 0 Then
  27.             If WsExist(Cherche) = True Then
  28.                 'determine la dernière ligne du tableau pour copier la ligne
  29.                 dernilgnetab = Sheets(Cherche).Range("A" & Rows.Count).End(xlUp).Row + 1
  30.                 'Copie la ligne
  31.                 Sheets(Feuille).Range(I & ":" & I).Copy Sheets(Cherche).Range("A" & dernilgnetab)
  32.                 'Met en surbrillance la valeur ayant généré le déplacement
  33.                 Sheets(Cherche).Cells(dernilgnetab, J).Interior.ColorIndex = 6
  34.                 Z = Z + 1
  35.                 GoTo FINJ
  36.             Else
  37.                 'Ajoute une feuille
  38.                 Sheets.Add
  39.                 'La nomme avec la valeur cherchée
  40.                 ActiveSheet.Name = Cherche
  41.                 'Copie l'entete des colonnes
  42.                 Sheets(Feuille).Range("1:1" ).Copy Sheets(Cherche).Range("A1" )
  43.                 'Copie la ligne
  44.                 Sheets(Feuille).Range(I & ":" & I).Copy Sheets(Cherche).Range("A2" )
  45.                 Sheets(Cherche).Cells(2, J).Interior.ColorIndex = 6
  46.                 Z = Z + 1
  47.                 GoTo FINJ
  48.             End If
  49.          End If
  50.     Next J
  51. FINJ:
  52. Next I
  53. If Z > 0 Then
  54. MsgBox (Z & " lignes trouvées avec la valeur " & Cherche & " collées dans la feuille " & Cherche)
  55. Sheets(Cherche).Select
  56. Else
  57. MsgBox ("Aucune Valeur trouvée" )
  58. End If
  60. End Sub
  61. Function WsExist(Nom$) As Boolean
  62. On Error Resume Next
  63. WsExist = Sheets(Nom).Index
  64. End Function

Reply

Marsh Posté le 31-07-2017 à 14:54:48    

Problème résolu merciiii :D

Reply

Sujets relatifs:

Leave a Replay

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