Renvoyer l'en-tête de colonne dans un msgbox

Membre supprimé 103233 · 17 Juillet 2009

Bonjour,

dans l'exemple joint, je souhaite afficher l'en-tête de colonne dans un msgbox d'une valeur "doublon".

Le fichier est plus parlant et contient la macro trouvée sur le forum, mais à compléter. Je ne sais pas le faire, car un vrai débutant.

Quelqu'un pourrait-il m'aider s'il vous plaît ?

Merci.

mromain · 17 Juillet 2009

Re : Renvoyer l'en-tête de colonne dans un msgbox

bonjour Sora3046 et bienvenue sur le forum,

essaye avec ce code :

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Application.CountIf(Range("G2:BQ2"), Target) > 1 Then
    [B]Set cellFind = Range("G2:BQ2").Find(Target, , , xlWhole)
    While cellFind.Address = Target.Address
        Set cellFind = Range("G2:BQ2").FindNext(cellFind)
    Wend[/B]
     MsgBox "Cette personne a déjà une autre participation [B](colonne """ & Cells(1, cellFind.Column).Text & """)[/B] ! Vérifie ta saisie !", vbCritical, "Saisie à double !"
End If
End Sub

a+

job75 · 17 Juillet 2009

Re : Renvoyer l'en-tête de colonne dans un msgbox

Bonjour Sora3046, bienvenue sur XLD,

La macro modifiée :

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ad As String
[COLOR="Red"]If Intersect(Target, Range("G2:BQ2")) Is Nothing Then Exit Sub[/COLOR]
ad = Range("G2:BQ2").Find(Target, After:=Target, LookIn:=xlValues, LookAt:=xlWhole).Address
If Target <> "" And Target.Address <> ad Then
  Target.Select
  MsgBox Target & " se trouve déjà en colonne " & Split(ad, "$")(1) & " !", vbCritical, "Saisie à double !"
End If
End Sub

Edit 1 : salut mromain 🙂

Edit 2 : ajouté le test en rouge

A+

youky(BJ) · 17 Juillet 2009

Re : Renvoyer l'en-tête de colonne dans un msgbox

Bienvenue Sora sur le forum,
Voici les quelques lignes de code à changer

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target = "" Then Exit Sub
For Each c In Range("G2:BQ2")
If c.Address <> Target.Address Then
If Target = c.Value Then
MsgBox "Cette personne a déjà une autre participation en " & Cells(1, c.Column) _
& vbCr & "Vérifie ta saisie !", vbCritical, "Saisie à double !"
Target.Select: Exit Sub
End If
End If
Next
End Sub

job75 · 17 Juillet 2009

Re : Renvoyer l'en-tête de colonne dans un msgbox

Re et salut youky,

J'avais pris l'en-tête de colonne au pied de la lettre... Une autre manière :

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("G2:BQ2")) Is Nothing Then Exit Sub
Dim ref As Range
Set ref = Range("G2:BQ2").Find(Target, After:=Target, LookIn:=xlValues, LookAt:=xlWhole)
If Target <> "" And Target.Address <> ref.Address Then
  Target.Select
  MsgBox Target & " a déjà une autre participation: " & Cells(1, ref.Column) & " ! Vérifie ta saisie !", vbCritical, "Saisie à double !"
End If
End Sub

A+

Membre supprimé 103233 · 18 Juillet 2009

RESOLU: Renvoyer l'en-tête de colonne dans un msgbox

Bonjour à tous,

merci de votre aide si rapide.

J'ai testé vos différentes méthode et je retiens celle de Job75 (la dernière) qui fait exactement ce je souhaitais.

Merci beaucoup.

Membre supprimé 103233 · 31 Juillet 2009

Re : Renvoyer l'en-tête de colonne dans un msgbox

Rebonjour à tous,

J'ai utilisé la macro de Job75 telle qu'écrite ci-dessus: ça fonctionne.

MAIS...

si je copie cette macro pour que le test se fasse sur chaque ligne individuellement, plus rien de ne fonctionne. Que fais-je de faux ?

Exemple ici de ce que j'ai fait (pour 3 lignes seulement, mais le fichier en contient 52 - pour les 52 semaines de l'année):

Private Sub Worksheet_Change2(ByVal Target As Range)
If Intersect(Target, Range("G2:BQ2")) Is Nothing Then Exit Sub
Dim ref As Range
Set ref = Range("G2:BQ2").Find(Target, After:=Target, LookIn:=xlValues, LookAt:=xlWhole)
If Target <> "" And Target.Address <> ref.Address Then
Target.Select
MsgBox Target & " a déjà une autre participation: " & Cells(1, ref.Column) & " ! " & vbCrLf & " " & vbCrLf & "Merci d'éviter de mettre plusieurs participations par frère le même soir. " & vbCrLf & " " & vbCrLf & "Vérifie ta saisie et corriges-là si nécessaire !", vbCritical, "Saisie à double !"
End If
End Sub

Private Sub Worksheet_Change3(ByVal Target As Range)
If Intersect(Target, Range("G3:BQ3")) Is Nothing Then Exit Sub
Dim ref As Range
Set ref = Range("G3:BQ3").Find(Target, After:=Target, LookIn:=xlValues, LookAt:=xlWhole)
If Target <> "" And Target.Address <> ref.Address Then
Target.Select
MsgBox Target & " a déjà une autre participation: " & Cells(1, ref.Column) & " ! " & vbCrLf & " " & vbCrLf & "Merci d'éviter de mettre plusieurs participations par frère le même soir. " & vbCrLf & " " & vbCrLf & "Vérifie ta saisie et corriges-là si nécessaire !", vbCritical, "Saisie à double !"
End If
End Sub

Private Sub Worksheet_Change4(ByVal Target As Range)
If Intersect(Target, Range("G4:BQ4")) Is Nothing Then Exit Sub
Dim ref As Range
Set ref = Range("G4:BQ4").Find(Target, After:=Target, LookIn:=xlValues, LookAt:=xlWhole)
If Target <> "" And Target.Address <> ref.Address Then
Target.Select
MsgBox Target & " a déjà une autre participation: " & Cells(1, ref.Column) & " ! " & vbCrLf & " " & vbCrLf & "Merci d'éviter de mettre plusieurs participations par frère le même soir. " & vbCrLf & " " & vbCrLf & "Vérifie ta saisie et corriges-là si nécessaire !", vbCritical, "Saisie à double !"
End If
End Sub

Merci de votre aide et soutien.

Belle journée.

Membre supprimé 103233 · 31 Juillet 2009

Re : Renvoyer l'en-tête de colonne dans un msgbox

Bonjour,

j'ai appliqué la méthode de Job75 qui fonctionne, mais lorsque je l'applique à plusieurs lignes (52 pour les 52 semaines de l'année), cela ne fonctionne plus.

J'ai copié-collé la macro et l'ai renommée pour chaque ligne dont je souhaitais un test de doublon lors de la saisie. Le chiffre après la macro correspond aussi à la ligne à tester.

Que fais-je de faux ?

Voici un extrait du code (qui est recopié 52 fois pour les 52 lignes individuelles à tester indépendamment les unes des autres).

****
Private Sub Worksheet_Change2(ByVal Target As Range)
If Intersect(Target, Range("G2:BQ2")) Is Nothing Then Exit Sub
Dim ref As Range
Set ref = Range("G2:BQ2").Find(Target, After:=Target, LookIn:=xlValues, LookAt:=xlWhole)
If Target <> "" And Target.Address <> ref.Address Then
Target.Select
MsgBox Target & " a déjà une autre participation: " & Cells(1, ref.Column) & " ! " & vbCrLf & " " & vbCrLf & "Merci d'éviter de mettre plusieurs participations par frère le même soir. " & vbCrLf & " " & vbCrLf & "Vérifie ta saisie et corriges-là si nécessaire !", vbCritical, "Saisie à double !"
End If
End Sub

Private Sub Worksheet_Change3(ByVal Target As Range)
If Intersect(Target, Range("G3:BQ3")) Is Nothing Then Exit Sub
Dim ref As Range
Set ref = Range("G3:BQ3").Find(Target, After:=Target, LookIn:=xlValues, LookAt:=xlWhole)
If Target <> "" And Target.Address <> ref.Address Then
Target.Select
MsgBox Target & " a déjà une autre participation: " & Cells(1, ref.Column) & " ! " & vbCrLf & " " & vbCrLf & "Merci d'éviter de mettre plusieurs participations par frère le même soir. " & vbCrLf & " " & vbCrLf & "Vérifie ta saisie et corriges-là si nécessaire !", vbCritical, "Saisie à double !"
End If
End Sub

Private Sub Worksheet_Change4(ByVal Target As Range)
If Intersect(Target, Range("G4:BQ4")) Is Nothing Then Exit Sub
Dim ref As Range
Set ref = Range("G4:BQ4").Find(Target, After:=Target, LookIn:=xlValues, LookAt:=xlWhole)
If Target <> "" And Target.Address <> ref.Address Then
Target.Select
MsgBox Target & " a déjà une autre participation: " & Cells(1, ref.Column) & " ! " & vbCrLf & " " & vbCrLf & "Merci d'éviter de mettre plusieurs participations par frère le même soir. " & vbCrLf & " " & vbCrLf & "Vérifie ta saisie et corriges-là si nécessaire !", vbCritical, "Saisie à double !"
End If
End Sub
*********

Merci de votre aide !

kjin · 31 Juillet 2009

Re : Renvoyer l'en-tête de colonne dans un msgbox

Bonjour,

Private Sub Worksheet_Change2

Cette procédure n'existe pas
Au plus simple

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Application.CountIf(Range(Cells(Target.Row, 7), Cells(Target.Row, 69)), Target) > 1 Then
     MsgBox "Cette personne a déjà une autre participation ! Vérifie ta saisie !", vbCritical, "Saisie à double !"
     Target.ClearContents
End If
End Sub

A+
kjin

Membre supprimé 103233 · 4 Août 2009

Re : Renvoyer l'en-tête de colonne dans un msgbox

Bonjour,

merci, ça fonctionne, mais est-ce néanmoins possible de récupérer la fonction qui me renvoyait sur la cellule du doublon et me citait l'en-tête de colonne ?

Merci de votre aide.

job75 · 8 Août 2009

Re : Renvoyer l'en-tête de colonne dans un msgbox

Bonjour le fil, le forum,

De retour d'une belle petite balade...

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("G2:BQ53")) Is Nothing Or Target.Count > 1 Then Exit Sub
Dim ref As Range
Set ref = Range("G" & Target.Row).Resize(, 63).Find(Target, After:=Target, LookIn:=xlValues, LookAt:=xlWhole)
If Target <> "" And Target.Column <> ref.Column Then
  Target.Select
  MsgBox Target & " a déjà une autre participation: " & Cells(1, ref.Column) & " ! Vérifie ta saisie !", vbCritical, "Saisie à double !"
End If
End Sub

A noter que j'avais oublié le test Target.Count > 1...

A+

Renvoyer l'en-tête de colonne dans un msgbox

Membre supprimé 103233

Guest

Pièces jointes

mromain

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

youky(BJ)

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Membre supprimé 103233

Guest

Membre supprimé 103233

Guest

Membre supprimé 103233

Guest

kjin

XLDnaute Barbatruc

Membre supprimé 103233

Guest

job75

XLDnaute Barbatruc

Discussions similaires

Renvoyer l'en-tête de colonne dans un msgbox

Membre supprimé 103233

Guest

Pièces jointes

mromain

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

youky(BJ)

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Membre supprimé 103233

Guest

Membre supprimé 103233

Guest

Membre supprimé 103233

Guest

kjin

XLDnaute Barbatruc

Membre supprimé 103233

Guest

job75

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency