Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force.
Apprenez, échangez, progressez – et tout ça gratuitement !
👉 Inscrivez-vous maintenant !
Je n’arrive pas à afficher correctement en VERT la date recherchée
Il m’affiche toute la colonne et me donne une erreur
Pour votre info, ce fichier est évolutif (= Insertion hebdomadaire de dates)
Je joins mon fichier en annexe
Étant donné que tes dates sont toujours dans la même colonne, pourquoi ne ferais-tu pas une boucle de la cellule B12 à la dernière ligne de ton tableau en utilisant un pas de 11 ?
A chaque étape, tu testes si la date saisie en A2 correspond.
Si tu arrives à la fin de ton tableau sans en avoir trouvé c'est qu'elle n'existe pas. Dans le cas contraire, tu peux sortir de ta boucle et effectuer les traitements que tu souhaites...
Ta proposition est pertinente
Etant un débutant en VBA, peux-tu m'écrire le code, et ce, sans te commander
Et aussi , si tu as le temps
Un TOUT TOUT GRAND MERCI pour ton aide
Jorisphi
Étant donné que tes dates sont toujours dans la même colonne, pourquoi ne ferais-tu pas une boucle de la cellule B12 à la dernière ligne de ton tableau en utilisant un pas de 11 ?
A chaque étape, tu testes si la date saisie en A2 correspond.
Si tu arrives à la fin de ton tableau sans en avoir trouvé c'est qu'elle n'existe pas. Dans le cas contraire, tu peux sortir de ta boucle et effectuer les traitements que tu souhaites...
Sub recherche()
For i = 13 To 65536 Step 11
If Sheets("1C1").Cells(i, 2) = Sheets("1C1").Cells(2, 1) Then
Range(Cells(i - 2, 2), Cells(i + 7, 2)).Interior.ColorIndex = 4
Exit For
End If
Next
End Sub
Par contre, il y a pas mal d'erreur générée par tes fonctions Worksheet_SelectionChange et Worksheet_Change.
Mais il bloque sur la ligne
"Range(Cells(i - 2, 2), Cells(i + 7, 2)).Interior.ColorIndex = 4"
J’ai seché hier soir et je ne trouve pas
Puis-je te renvoyer mon nouveau fichier sans les fonctions d’erreur ?
Grand merci d’avance
Cijoint.fr - Service gratuit de dépôt de fichiers
Pour ton info, mon code suivant sert à changer le nom de l'onglet
Il faudrait donc inclure cet argument dans IF Sheets("1C1")
Et aussi un MsgBox : « Date inexistante » si non Trouvé
(Je suis vraiment difficile, mais c’est grâce à des personnes comme toi, que j’apprends)
Encore Merci
Jorisphi
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("P6")) Is Nothing Then Exit Sub
ActiveSheet.Name = ActiveSheet.Range("P6").Value
End Sub
Sub recherche()
For i = 13 To 65536 Step 11
If Sheets("1C1").Cells(i, 2) = Sheets("1C1").Cells(2, 1) Then
Range(Cells(i - 2, 2), Cells(i + 7, 2)).Interior.ColorIndex = 4
Exit For
End If
Next
End Sub
Par contre, il y a pas mal d'erreur générée par tes fonctions Worksheet_SelectionChange et Worksheet_Change.
Étonnant, cela fonctionnait de mon côté excepté les erreurs que je mentionnais dans mon dernier message.
Je jette un coup d'oeil à ton fichier et reviens.
Sly
C'est la protection de ta feuille qui pose problème à mon avis.
Je viens de tester rapidement ce bout de code écrit dans la feuille "1C1" et cela fonctionne chez moi
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("P6")) Is Nothing Then Exit Sub
ActiveSheet.Name = ActiveSheet.Range("P6").Value
End Sub
Sub recherche()
Sheets("1C1").Unprotect
For i = 13 To 65536 Step 11
If Sheets("1C1").Cells(i, 2) = Sheets("1C1").Cells(2, 1) Then
Range(Cells(i - 2, 2), Cells(i + 7, 2)).Select
Selection.Interior.Color = 65280
Exit For
End If
Next
Sheets("1C1").Protect
End Sub
Si tu ne peux accéder à ton code que par la feuille dans laquelle tu souhaites effectuer ta recherche, tu peux utiliser cette variante, qui fait abstraction du nom de la feuille
Code:
Sub recherchebis()
ActiveSheet.Unprotect
For i = 13 To 65536 Step 11
If ActiveSheet.Cells(i, 2) = ActiveSheet.Cells(2, 1) Then
Range(Cells(i - 2, 2), Cells(i + 7, 2)).Select
Selection.Interior.Color = 65280
Exit For
End If
Next
ActiveSheet.Protect
End Sub
En espérant répondre à ton besoin
Sly
Je viens aussi de tester, et tu es un AS !.......
Cela fonctionne à merveille
Ton premier code fonctionnait à merveille et c'est moi qui a été pris comme un "Bleu"
Il fallait déprotéger la Feuille !.........
J'ai encore appris grace à toi
Juste une petite chose et je te laisserai tranquille
Comment faire pour désactiver la couleur sélectionnée précedemment
(Car lors d'une nouvelle recherche, il laisse la couleur recherchée précédente)
Et si possible un msgBox "Date inexistante" si non trouvée
Voilà
Encore un TOUT TOUT GRNAD MERCI pour ton aide précieuse et aussi pour ton coaching
Très cordialement
Jorisphi
Sub recherchebis()
ActiveSheet.Unprotect
Dim cpt As Integer
cpt = 0
Columns("B:B").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
For i = 13 To 65536 Step 11
If ActiveSheet.Cells(i, 2) = ActiveSheet.Cells(2, 1) Then
Range(Cells(i - 2, 2), Cells(i + 7, 2)).Select
Selection.Interior.Color = 65280
cpt = 1
Exit For
End If
Next
If cpt = 0 Then
MsgBox "Date inexistante", vbOKOnly, "Information"
End If
ActiveSheet.Protect
End Sub
Je rajoute une variable qui prend la valeur 1 quand la date est trouvée. Si elle n'est pas trouvée, elle reste donc à 0 et o affiche un message.
Sub recherchebis()
ActiveSheet.Unprotect
Dim cpt As Integer
cpt = 0
Columns("B:B").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
For i = 13 To 65536 Step 11
If ActiveSheet.Cells(i, 2) = ActiveSheet.Cells(2, 1) Then
Range(Cells(i - 2, 2), Cells(i + 7, 2)).Select
Selection.Interior.Color = 65280
cpt = 1
Exit For
End If
Next
If cpt = 0 Then
MsgBox "Date inexistante", vbOKOnly, "Information"
End If
ActiveSheet.Protect
End Sub
Je rajoute une variable qui prend la valeur 1 quand la date est trouvée. Si elle n'est pas trouvée, elle reste donc à 0 et o affiche un message.
Avec ce code collé dans l'onglet vba de la feuille "1C1",
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("P6")) Is Nothing Then Exit Sub
ActiveSheet.Name = ActiveSheet.Range("P6").Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$2" Then Recherchedate
End Sub
Sub Recherchedate()
ActiveSheet.Unprotect
Dim cpt As Integer
cpt = 0
Columns("B:B").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
For i = 13 To 65536 Step 11
If ActiveSheet.Cells(i, 2) = ActiveSheet.Cells(2, 1) Then
Range(Cells(i - 2, 2), Cells(i + 7, 2)).Select
Selection.Interior.Color = 65280
cpt = 1
Exit For
End If
Next
If cpt = 0 Then
MsgBox "Date inexistante", vbOKOnly, "Information"
End If
ActiveSheet.Protect
End Sub
cela fonctionne sur mon poste avec le fichier que tu as communiqué...
- Navigue sans publicité - Accède à Cléa, notre assistante IA experte Excel... et pas que... - Profite de fonctionnalités exclusives Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel. Je deviens Supporter XLD