Problème colonne vba

[judoka0209]

Bonsoir, J'ai créé un code mais quand je tape 21 dans la cellule il me met d'office le msgbox et si j'ai déjà mis 2 case contenant 21 il me met aussi la msgbox je voudrais qu'il traite l'information que par colonne
Merci

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C6:NC11")) Is Nothing Then Exit Sub
Dim macolonne As Range

Set macolonne = Range(Cells(6, Target.Column), Cells(11, Target.Column))
If Application.WorksheetFunction.CountIf(macolonne, "21") + Application.WorksheetFunction.CountIf(macolonne, "21nd") = 2 Or _
Application.WorksheetFunction.CountIf(macolonne, "21") + Application.WorksheetFunction.CountIf(macolonne, "21") = 2 Or _
Application.WorksheetFunction.CountIf(macolonne, "21") + Application.WorksheetFunction.CountIf(macolonne, "10") = 2 Or _
Application.WorksheetFunction.CountIf(macolonne, "21") + Application.WorksheetFunction.CountIf(macolonne, "10nd") = 2 Or _
Application.WorksheetFunction.CountIf(macolonne, "21") + Application.WorksheetFunction.CountIf(macolonne, "33") = 2 Or _
Application.WorksheetFunction.CountIf(macolonne, "21") + Application.WorksheetFunction.CountIf(macolonne, "DE") = 2 Or _
Application.WorksheetFunction.CountIf(macolonne, "21") + Application.WorksheetFunction.CountIf(macolonne, "Rsec") = 2 Or _
Application.WorksheetFunction.CountIf(macolonne, "21") + Application.WorksheetFunction.CountIf(macolonne, "GTA") = 2 Or _
Application.WorksheetFunction.CountIf(macolonne, "21") + Application.WorksheetFunction.CountIf(macolonne, "SST") = 2 Or _
Application.WorksheetFunction.CountIf(macolonne, "21") + Application.WorksheetFunction.CountIf(macolonne, "FP") = 2 Or _
Application.WorksheetFunction.CountIf(macolonne, "21") + Application.WorksheetFunction.CountIf(macolonne, "35") = 2 Or _
Application.WorksheetFunction.CountIf(macolonne, "21") + Application.WorksheetFunction.CountIf(macolonne, "507i0") = 2 Or _
Application.WorksheetFunction.CountIf(macolonne, "21") + Application.WorksheetFunction.CountIf(macolonne, "AKPS") = 2 Or _
Application.WorksheetFunction.CountIf(macolonne, "21") + Application.WorksheetFunction.CountIf(macolonne, "AKSC") = 2 Or _
Application.WorksheetFunction.CountIf(macolonne, "21") + Application.WorksheetFunction.CountIf(macolonne, "CGCD") = 2 Or _
Application.WorksheetFunction.CountIf(macolonne, "21") + Application.WorksheetFunction.CountIf(macolonne, "41") = 2 Or _
Application.WorksheetFunction.CountIf(macolonne, "21") + Application.WorksheetFunction.CountIf(macolonne, "22") = 2 Or _
Application.WorksheetFunction.CountIf(macolonne, "21") + Application.WorksheetFunction.CountIf(macolonne, "51") = 2 Or _
Application.WorksheetFunction.CountIf(macolonne, "21") + Application.WorksheetFunction.CountIf(macolonne, "S2") = 2 Or _
Application.WorksheetFunction.CountIf(macolonne, "21") + Application.WorksheetFunction.CountIf(macolonne, "S4") = 2 Or _
Application.WorksheetFunction.CountIf(macolonne, "21") + Application.WorksheetFunction.CountIf(macolonne, "S9") = 2 Or _
Application.WorksheetFunction.CountIf(macolonne, "21") + Application.WorksheetFunction.CountIf(macolonne, "8G") = 2 Or _
Application.WorksheetFunction.CountIf(macolonne, "21") + Application.WorksheetFunction.CountIf(macolonne, "8F") = 2 Or _
Application.WorksheetFunction.CountIf(macolonne, "21") + Application.WorksheetFunction.CountIf(macolonne, "L4") = 2 Or _
Application.WorksheetFunction.CountIf(macolonne, "21") + Application.WorksheetFunction.CountIf(macolonne, "R Sec") = 2 Then
MsgBox "attention"

End If


End Sub

 

[Lone-wolf]

Re

Je viens de faire un test avec ce code, la msgbox s'affiche, regarde si c'est cela que tu cherche à faire.

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cel As Range, Cde, Code(1 To 24)
If Not Intersect(Target, Range("C6:NC11")) Is Nothing Then
Set cel = ActiveCell.Offset(0, -1)

Cde = WorksheetFunction.CountIf(cel, "21")

Code(1) = WorksheetFunction.CountIf(cel, "21nd"): Code(2) = WorksheetFunction.CountIf(cel, "10")
Code(3) = WorksheetFunction.CountIf(cel, "10nd"): Code(4) = WorksheetFunction.CountIf(cel, "33")
Code(5) = WorksheetFunction.CountIf(cel, "DE"): Code(6) = WorksheetFunction.CountIf(cel, "Rsec")
Code(7) = WorksheetFunction.CountIf(cel, "GTA"): Code(8) = WorksheetFunction.CountIf(cel, "SST")
Code(9) = WorksheetFunction.CountIf(cel, "FP"): Code(10) = WorksheetFunction.CountIf(cel, "35")
Code(11) = WorksheetFunction.CountIf(cel, "507i0"): Code(12) = WorksheetFunction.CountIf(cel, "AKPS")
Code(13) = WorksheetFunction.CountIf(cel, "AKSC"): Code(14) = WorksheetFunction.CountIf(cel, "CGCD")
Code(15) = WorksheetFunction.CountIf(cel, "41"): Code(16) = WorksheetFunction.CountIf(cel, "22")
Code(17) = WorksheetFunction.CountIf(cel, "51"): Code(18) = WorksheetFunction.CountIf(cel, "S2")
Code(19) = WorksheetFunction.CountIf(cel, "S4"): Code(20) = WorksheetFunction.CountIf(cel, "S9")
Code(21) = WorksheetFunction.CountIf(cel, "8F"): Code(22) = WorksheetFunction.CountIf(cel, "8G")
Code(23) = WorksheetFunction.CountIf(cel, "LA"): Code(24) = WorksheetFunction.CountIf(cel, "R sec")

If Cde + Cde >= 2 Then: MsgBox "attention": Exit Sub
If Cde + Code(1) >= 2 Then: MsgBox "attention": Exit Sub
If Cde + Code(2) >= 2 Then: MsgBox "attention": Exit Sub
If Cde + Code(3) >= 2 Then: MsgBox "attention": Exit Sub
If Cde + Code(4) >= 2 Then: MsgBox "attention": Exit Sub
If Cde + Code(5) >= 2 Then: MsgBox "attention": Exit Sub
If Cde + Code(6) >= 2 Then: MsgBox "attention": Exit Sub
If Cde + Code(7) >= 2 Then: MsgBox "attention": Exit Sub
If Cde + Code(8) >= 2 Then: MsgBox "attention": Exit Sub
If Cde + Code(9) >= 2 Then: MsgBox "attention": Exit Sub
If Cde + Code(10) >= 2 Then: MsgBox "attention": Exit Sub
If Cde + Code(11) >= 2 Then: MsgBox "attention": Exit Sub
If Cde + Code(12) >= 2 Then: MsgBox "attention": Exit Sub
If Cde + Code(13) >= 2 Then: MsgBox "attention": Exit Sub
If Cde + Code(14) >= 2 Then: MsgBox "attention": Exit Sub
If Cde + Code(15) >= 2 Then: MsgBox "attention": Exit Sub
If Cde + Code(16) >= 2 Then: MsgBox "attention": Exit Sub
If Cde + Code(17) >= 2 Then: MsgBox "attention": Exit Sub
If Cde + Code(18) >= 2 Then: MsgBox "attention": Exit Sub
If Cde + Code(19) >= 2 Then: MsgBox "attention": Exit Sub
If Cde + Code(20) >= 2 Then: MsgBox "attention": Exit Sub
If Cde + Code(21) >= 2 Then: MsgBox "attention": Exit Sub
If Cde + Code(22) >= 2 Then: MsgBox "attention": Exit Sub
If Cde + Code(23) >= 2 Then: MsgBox "attention": Exit Sub
If Cde + Code(24) >= 2 Then: MsgBox "attention": Exit Sub
End If

End Sub

 

[judoka0209]

Il se passe rien

 

[judoka0209]

Tu as pas un mail que je t'envoie le fichier

 

[Lone-wolf]

Tu utilise quoi comme Office 2003 - 2007 ...?? Et tu peux mettre le fichier ici. Tu as le bouton Téléverser un fichier.

 

[judoka0209]

Oui pour Excel
Et non pour le transférer je suis sur le PCP pro et g pas internet je te donne mon mail envoie un message et je te renvoie le fichier je jongle avec mon tel
Pain0403@sfr.fr

 

[Lone-wolf]

Re

Oui pour Excel

Mais c'est quoi la version? 2003 - 2007 - 2010 - 2013 ???
Si tu as la version inferieure à 2010, je ne peux rien faire de plus.

je suis sur le PCP pro et g pas internet

Ah bon? , donc la tu es chez toi.

 

[judoka0209]

Re



Mais c'est quoi la version? 2003 - 2007 - 2010 - 2013 ???



Ah bon? , donc la tu es chez toi.

Non boulot

 

[judoka0209]

2007

Non boulot

 

[Lone-wolf]

Ce n'est pas une reponse ça.
Clique sur Fichier, ensuite sur aide; tu devrais avoir la version.

 

[judoka0209]

Excel 2007

 

[Lone-wolf]

Bonjour judoka

Comme je l'ai dit, je ne peux rien faire de plus. La dernière macro était fonctionnnelle chez moi.

 

[judoka0209]

ok je te remercie bien pour le temps que tu as pris pour m'aider c'etait super sympa