Forum |  HardWare.fr | News | Articles | PC | Prix | S'identifier | S'inscrire | Aide | Shop Recherche
1875 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  champs de saisie qu permet d'isoler une ligne

 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

champs de saisie qu permet d'isoler une ligne

n°2303003
elio55
l\
Posté le 06-07-2017 à 15:57:23  profilanswer
 

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
mood
Publicité
Posté le 06-07-2017 à 15:57:23  profilanswer
 

n°2303067
wago
Posté le 07-07-2017 à 21:32:40  profilanswer
 

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()
  2. 'déclaration des variables
  3. Dim ligne As String
  4. Dim feuil1 As String
  5. Dim feuil2 As String
  6. 'Boite de dialogue demandant la ligne à déplacer
  7. ligne = InputBox("Veuillez entrez le numéro de ligne à copier", "?" )
  8. 'Stocke le nom de la feuille de départ
  9. feuil1 = ActiveSheet.Name
  10. 'Créé une nouvelle feuille et stocke son nom
  11. Sheets.Add
  12. feuil2 = ActiveSheet.Name
  13. 'Copie la ligne dans la nouvelle feuille
  14. Sheets(feuil1).Range(ligne & ":" & ligne).Copy Sheets(feuil2).Range("A1" )
  15. 'Supprime la ligne dans la feuille de départ
  16. Sheets(feuil1).Range(ligne & ":" & ligne).Delete Shift:=xlUp
  17. 'reselectionne la feuille de départ
  18. Sheets(feuil1).Select
  19. 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()
  2. 'déclaration des variables
  3. Dim ligne As String
  4. Dim Cellule As String
  5. Dim feuil1 As String
  6. Dim Feuil2 As String
  7. 'Boite de dialogue demandant la cellule dont la ligne est à déplacer
  8. Cellule = InputBox("Veuillez entrez l'adresse de la cellule dont la ligne est à déplacer", "?" )
  9. ligne = Range(Cellule).Row
  10. 'Stocke le nom de la feuille de départ
  11. feuil1 = ActiveSheet.Name
  12. 'Créé une nouvelle feuille et stocke son nom
  13. Sheets.Add
  14. Feuil2 = ActiveSheet.Name
  15. 'Copie la ligne dans la nouvelle feuille
  16. Sheets(feuil1).Range(ligne & ":" & ligne).Copy Sheets(Feuil2).Range("A1" )
  17. Sheets(feuil1).Range(ligne & ":" & ligne).Delete Shift:=xlUp
  18. 'reselectionne la feuille de départ
  19. Sheets(feuil1).Select
  20. End Sub


Message édité par wago le 07-07-2017 à 23:30:20
n°2303134
elio55
l\
Posté le 10-07-2017 à 10:48:51  profilanswer
 

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 ?

n°2303866
wago
Posté le 26-07-2017 à 22:15:20  profilanswer
 

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.
 

n°2303885
elio55
l\
Posté le 27-07-2017 à 10:26:34  profilanswer
 

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

n°2303910
wago
Posté le 27-07-2017 à 16:32:18  profilanswer
 

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

n°2303932
wago
Posté le 27-07-2017 à 19:20:40  profilanswer
 

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

n°2303955
elio55
l\
Posté le 28-07-2017 à 10:46:42  profilanswer
 

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

n°2303956
elio55
l\
Posté le 28-07-2017 à 10:48:43  profilanswer
 

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

n°2303964
wago
Posté le 28-07-2017 à 13:08:18  profilanswer
 

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

mood
Publicité
Posté le 28-07-2017 à 13:08:18  profilanswer
 

n°2303994
wago
Posté le 29-07-2017 à 10:18:54  profilanswer
 

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
  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" ))
  15. Z = 0
  16. 'Boite de dialogue demandant la valeur de cellule dont la ligne est à déplacer
  17. Cherche = InputBox("Veuillez entrez le texte recherché", "?" )
  18. 'Boucle sur les lignes
  19. For I = 2 To NbLigne
  20.     'Boucle sur les colonnes
  21.     For J = 1 To NbColonne
  22.         'teste la présence de la feuille, si non la créé
  23.         If InStr(Sheets(Feuille).Cells(I, J), Cherche) > 0 Then
  24.             If WsExist(Cherche) = True Then
  25.                 'determine la dernière ligne du tableau pour copier la ligne
  26.                 dernilgnetab = Sheets(Cherche).Range("A" & Rows.Count).End(xlUp).Row + 1
  27.                 'Copie la ligne
  28.                 Sheets(Feuille).Range(I & ":" & I).Copy Sheets(Cherche).Range("A" & dernilgnetab)
  29.                 'Met en surbrillance la valeur ayant généré le déplacement
  30.                 Sheets(Cherche).Cells(dernilgnetab, J).Interior.ColorIndex = 6
  31.                 Z = Z + 1
  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.                 Z = Z + 1
  44.                 GoTo FINJ
  45.             End If
  46.          End If
  47.     Next J
  48. FINJ:
  49. Next I
  50. If Z > 0 Then
  51. MsgBox (Z & " lignes trouvées avec la valeur " & Cherche & " collées dans la feuille " & Cherche)
  52. Sheets(Cherche).Select
  53. Else
  54. MsgBox ("Aucune Valeur trouvée" )
  55. End If
  56. End Sub
  57. Function WsExist(Nom$) As Boolean
  58. On Error Resume Next
  59. WsExist = Sheets(Nom).Index
  60. End Function

n°2304029
elio55
l\
Posté le 31-07-2017 à 14:54:48  profilanswer
 

Problème résolu merciiii :D


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  champs de saisie qu permet d'isoler une ligne

 

Sujets relatifs
lister les champs d'une table en connexion odbcpb sauts de ligne $.ajax
Champs email en code qui renvoi vers formulaire d'inscriptionJe voudrais sélectionner une ligne du tableau
supprimer le premier ligne d'un fichierselection ligne tableau pour requête
Executer une ligne de commande windows en javasupprimer retour à la ligne
supprimer plusieurs retours à la lignelancer un programme python en ligne de commande sous windows
Plus de sujets relatifs à : champs de saisie qu permet d'isoler une ligne



Copyright © 1997-2016 Hardware.fr SARL (Signaler un contenu illicite) / Groupe LDLC / Shop HFR