Problème colonne vba

judoka0209 · 5 Octobre 2016

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 · 5 Octobre 2016

Bonsoir judoka

J'ai du mal à saisir. À quoi correspondent, "21" - "21nd" - "33" - + etc???

Un exemple

With Feuil2
derlig = .Range("b" & Rows.Count).End(xlUp).Row
For k = 2 To derlig 'Compter les cellules C:C qui correspondent au cellules B:C
.Range("c" & k) = Application.CountIf(Feuil1.Range("c2:c65536"), .Range("b" & k))
End With

judoka0209 · 5 Octobre 2016

C'est des code d'absence professionnel

Lone-wolf · 5 Octobre 2016

Ok. et pourquoi countif + countif?? Est-ce que ce ne serait pas plutôt CountIf (21) And CountIf (21nd) >= 2

judoka0209 · 6 Octobre 2016

Ça marche comme ça à vrai dire je débute alors c'est pas simple pour moi
Mais c pas ça mon problème

judoka0209 · 6 Octobre 2016

Il faut que je vérifie que dans la colonne c6:c11 j'ai 10/21/21nd etc.... et message
Après même chose pour d6:d11
Mais le problème c'est que des que j'ai déjà mis un 21 en c6 j'ai mon message qui apparaît
Je c pas si c très clair

Lone-wolf · 6 Octobre 2016

Re

Un essai avec ce code-ci

VB:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C6:NC11")) Is Nothing Then Exit Sub
Dim cel As Range, Cde21 As Variant, Code(1 To 24) As Variant

If Target.Count > 1 Then Exit Sub
Set cel = Target.Offset(0, 0)

Cde21 = 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 Cde21 And Cde21 >= 2 Then: MsgBox "attention": Exit Sub
If Cde21 And Code(1) >= 2 Then: MsgBox "attention": Exit Sub
If Cde21 And Code(2) >= 2 Then: MsgBox "attention": Exit Sub
If Cde21 And Code(3) >= 2 Then: MsgBox "attention": Exit Sub
If Cde21 And Code(4) >= 2 Then: MsgBox "attention": Exit Sub
If Cde21 And Code(5) >= 2 Then: MsgBox "attention": Exit Sub
If Cde21 And Code(6) >= 2 Then: MsgBox "attention": Exit Sub
If Cde21 And Code(7) >= 2 Then: MsgBox "attention": Exit Sub
If Cde21 And Code(8) >= 2 Then: MsgBox "attention": Exit Sub
If Cde21 And Code(9) >= 2 Then: MsgBox "attention": Exit Sub
If Cde21 And Code(10) >= 2 Then: MsgBox "attention": Exit Sub
If Cde21 And Code(11) >= 2 Then: MsgBox "attention": Exit Sub
If Cde21 And Code(12) >= 2 Then: MsgBox "attention": Exit Sub
If Cde21 And Code(13) >= 2 Then: MsgBox "attention": Exit Sub
If Cde21 And Code(14) >= 2 Then: MsgBox "attention": Exit Sub
If Cde21 And Code(15) >= 2 Then: MsgBox "attention": Exit Sub
If Cde21 And Code(16) >= 2 Then: MsgBox "attention": Exit Sub
If Cde21 And Code(17) >= 2 Then: MsgBox "attention": Exit Sub
If Cde21 And Code(18) >= 2 Then: MsgBox "attention": Exit Sub
If Cde21 And Code(19) >= 2 Then: MsgBox "attention": Exit Sub
If Cde21 And Code(20) >= 2 Then: MsgBox "attention": Exit Sub
If Cde21 And Code(21) >= 2 Then: MsgBox "attention": Exit Sub
If Cde21 And Code(22) >= 2 Then: MsgBox "attention": Exit Sub
If Cde21 And Code(23) >= 2 Then: MsgBox "attention": Exit Sub
If Cde21 And Code(24) >= 2 Then: MsgBox "attention": Exit Sub
End Sub

judoka0209 · 6 Octobre 2016

J'ai une erreur de compilation
Seul des commentaires peuvent apparaître après end sub,end function

judoka0209 · 6 Octobre 2016

Regarde

Lone-wolf · 6 Octobre 2016

Re

Un autre

VB:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C6:NC11")) Is Nothing Then Exit Sub
Dim cel As Range, i As Long, Cde , Code(1 To 24)

Application.EnableEvents = False

On Error Resume next

Set cel = ActiveCell.Offset(0, 0)
If Target.Count > 1 Then Exit Sub
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")

For i = 1 To 24
If Cde And Code(i) >= 2 Then
Exit For
MsgBox "attention"
End If
Next i
Application.EnableEvents = True

End Sub

judoka0209 · 6 Octobre 2016

Encore une erreur

Lone-wolf · 6 Octobre 2016

Normal

Il faut placer la macro avant l'appel des boutons

Option Explicit
Private Sub Worksheet.........
Le code
End Sub

Private sub CommandButton1()
xxxxx
End Sub

EDIT: il faut mettre Cde21 = WorksheetFunction.CountIf(cel, "21") après la ligne Set cel = Target.offset(0, 0), désolé pour l'erreur. Enlève aussi As Variant pour voir.

judoka0209 · 6 Octobre 2016

But toujours

Lone-wolf · 6 Octobre 2016

Re

Reprend le 2ème code que je viens de corriger pour voir.

judoka0209 · 6 Octobre 2016

Rien ne se passe mais ça bug plus

Problème colonne vba

judoka0209

XLDnaute Occasionnel

Lone-wolf

XLDnaute Barbatruc

judoka0209

XLDnaute Occasionnel

Lone-wolf

XLDnaute Barbatruc

judoka0209

XLDnaute Occasionnel

judoka0209

XLDnaute Occasionnel

Lone-wolf

XLDnaute Barbatruc

judoka0209

XLDnaute Occasionnel

judoka0209

XLDnaute Occasionnel

Pièces jointes

Lone-wolf

XLDnaute Barbatruc

judoka0209

XLDnaute Occasionnel

Pièces jointes

Lone-wolf

XLDnaute Barbatruc

judoka0209

XLDnaute Occasionnel

Pièces jointes

Lone-wolf

XLDnaute Barbatruc

judoka0209

XLDnaute Occasionnel

Pièces jointes

Discussions similaires