Problème colonne vba

J

judoka0209

XLDnaute Occasionnel
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
 
Trier par date Trier par votes
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Bonsoir judoka

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

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
 
Dernière édition:
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
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
 
Dernière édition:
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
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
 
Dernière édition:
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
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.

 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

B
  • Résolu(e)
Microsoft 365 Besoin d'aide pour faire fonctionner 2 codes VBA ensemble
Réponses
2
Affichages
261
BenExcel
B
D
  • Question
XL 2019 Recherche chiffre avec VBA
Réponses
3
Affichages
813
damso
D
C
  • Question
XL 2021 Problème de remplissage d'une colonne conditionné à d'autres valeurs
Réponses
2
Affichages
264
CathyLD
C
U
  • Question
Autres Enregistrer sur Onglet TOTO
Réponses
2
Affichages
467
un internaute
U
M
  • Résolu(e)
XL 2016 VBA - Condition plage cellule feuille 1 par rapport a une colonne en feuille 2
Réponses
2
Affichages
463
Maxime26
M
E
  • Question
Microsoft 365 Problème macro événementielle
Réponses
2
Affichages
922
ExcLnoob
E
M
  • Résolu(e)
XL 2016 Lien hyperlink ne s'ouvre pas
Réponses
2
Affichages
403
MickaeL_D
M
U
  • Question
Autres {RÉSOLU] Problème macro
Réponses
2
Affichages
598
un internaute
U
B
  • Question
Microsoft 365 formulaire VBA problème
Réponses
3
Affichages
785
herve62
herve62
D
  • Résolu(e)
XL 2013 Copie vers un autre classeur avec condition
Réponses
2
Affichages
860
Dafaka7
D

Membres actuellement en ligne

15 membres et 107 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 195
Messages
2 107 029
Membres
109 738
dernier inscrit
cedrebey