XL 2016 Afficher la ligne selon une seule donnée

Gabriel.leroux82

XLDnaute Nouveau
Bonjour,

Je viens encore vers vous chercher des solutions à mon problème d'Excel, j'ai crée un calendrier des employés, ils doivent remplir à chaque semaine avec leur quart de travail, ce fichier contient des macros et un userform qui s'affiche à l'ouverture afin de donner aux employés la possibilité de cliquer sur un bouton et sélectionner un quart de travail.

Ma question : avec les employés qui arrivent dans le service, mon fichier contient une 40 de ligne, j'aimerais trouver un moyen pour que quand l'employé tape son numéro, la ligne complète correspondante s'affiche sur le même onglet, j'ai un onglet par mois,
J'ai mis une petite démonstration de ce que je veux faire en pièce jointe, le fichier principal contient beaucoup d'info confidentiel.

Je vous remercie d'avance pour votre temps
 

Pièces jointes

  • testligne.xlsx
    17.5 KB · Affichages: 10
Dernière édition:
Solution
Bonjour Gabriel.leroux82,

Fichier (2) avec masquage/affichage des lignes :
VB:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not IsDate("1/" & Sh.Name) Or Target.Address <> "$D$4" Then Exit Sub
If LCase(Sh.Name) <> Format(Date, "mmmm") And Target <> "" Then MsgBox "Activez la feuille du mois en cours !", 48: Exit Sub
Application.ScreenUpdating = False
Rows.Hidden = False 'affiche tout
ActiveWindow.ScrollColumn = 1
If Target = "" Then Exit Sub
Dim derlig&, c As Range
If Sh.FilterMode Then Sh.ShowAllData 'si la feuille est filtrée
derlig = Range("B" & Rows.Count).End(xlUp).Row
If derlig < 10 Then Exit Sub 'si aucun numéro
Set c = Range("B10:B" & derlig).Find([D4], , xlValues, xlWhole)
Rows("10:" &...

job75

XLDnaute Barbatruc
Voyez le fichier .xlsm joint et cette macro dans ThisWorkbook :
VB:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not IsDate("1/" & Sh.Name) Or Target.Address <> "$D$4" Then Exit Sub
If LCase(Sh.Name) <> Format(Date, "mmmm") And Target <> "" Then MsgBox "Activez la feuille du mois en cours !", 48: Exit Sub
If Target = "" Then ActiveWindow.ScrollRow = 1: ActiveWindow.ScrollColumn = 1: Exit Sub
Dim c As Range
Set c = Range("B10:B" & Rows.Count).Find([D4], , xlValues, xlWhole)
If Not c Is Nothing Then Application.Goto c(1, 3 + Day(Date)), True 'cadrage sur le jour à remplir
End Sub
 

Pièces jointes

  • testligne(1).xlsm
    27.3 KB · Affichages: 4

Gabriel.leroux82

XLDnaute Nouveau
Bonjour et merci pour la réponse,
Le problème est quand je tape le numéro d'employé, la ligne correspondante et les autres en dessous s'afficheront, il préférable que seulement la ligne de l'employé s'affiche,
J'ai essayé aussi d'enlever le positionnement sur la case date du jour mais je n'ai pas réussi.
Merci beaucoup pour votre aide.
 

job75

XLDnaute Barbatruc
Bonjour Gabriel.leroux82,

Fichier (2) avec masquage/affichage des lignes :
VB:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not IsDate("1/" & Sh.Name) Or Target.Address <> "$D$4" Then Exit Sub
If LCase(Sh.Name) <> Format(Date, "mmmm") And Target <> "" Then MsgBox "Activez la feuille du mois en cours !", 48: Exit Sub
Application.ScreenUpdating = False
Rows.Hidden = False 'affiche tout
ActiveWindow.ScrollColumn = 1
If Target = "" Then Exit Sub
Dim derlig&, c As Range
If Sh.FilterMode Then Sh.ShowAllData 'si la feuille est filtrée
derlig = Range("B" & Rows.Count).End(xlUp).Row
If derlig < 10 Then Exit Sub 'si aucun numéro
Set c = Range("B10:B" & derlig).Find([D4], , xlValues, xlWhole)
Rows("10:" & derlig).Hidden = True 'masque tous les numéros
If c Is Nothing Then Exit Sub
c.EntireRow.Hidden = False 'affiche le numéro trouvé
ActiveWindow.ScrollColumn = 4 + Day(Date) 'cadrage sur le jour à remplir
c(1, 3 + Day(Date)).Select
End Sub
A+
 

Pièces jointes

  • testligne(2).xlsm
    28.6 KB · Affichages: 3

Gabriel.leroux82

XLDnaute Nouveau
Bonjour, je l'ai copié dans mon fichier, et je ne comprends pas pourquoi il ne s'exécute pas
Pourriez-vous m'aider svp,



Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not IsDate("1/" & Sh.Name) Or Target.Address <> "$C$3" Then Exit Sub
' If LCase(Sh.Name) <> Format(Date, "mmmm") And Target <> "" Then MsgBox "Activez la feuille du mois en cours !", 48: Exit Sub
Application.ScreenUpdating = False
Rows.Hidden = False 'affiche tout
ActiveWindow.ScrollColumn = 1
If Target = "" Then Exit Sub
Dim derlig&, c As Range
If Sh.FilterMode Then Sh.ShowAllData 'si la feuille est filtrée
derlig = Range("A" & Rows.Count).End(xlUp).Row
If derlig < 10 Then Exit Sub 'si aucun numéro
Set c = Range("A7:A" & derlig).Find([C3], , xlValues, xlWhole)
Rows("7:" & derlig).Hidden = True 'masque tous les numéros
If c Is Nothing Then Exit Sub
c.EntireRow.Hidden = False 'affiche le numéro trouvé
' ActiveWindow.ScrollColumn = 4 + Day(Date) 'cadrage sur le jour à remplir
c(1, 3 + Day(Date)).Select


End Sub


Private Sub Workbook_Open()

Dim Chaine As String, L As Integer
With Sheets("Liste_outil")
For L = 3 To .Range("A65500").End(xlUp).Row
If .Cells(L, "A") = Date Then
Chaine = Chaine & .Cells(L, "B") & Chr(10)
End If
Next L
If Chaine = "" Then
' MsgBox "Pas d'alerte aujourd'hui" ' A supprimer si je ne veut pas de msgbox si pas d'alerte
Else
MsgBox Chaine, vbInformation
End If
End With
UserForm1.Show

End Sub
 

Pièces jointes

  • TESTLIGNE.xlsm
    26.2 KB · Affichages: 5

Discussions similaires

Réponses
5
Affichages
288