XL 2019 dénombrer deux cellules distinctes sur chaque ligne

[Omkara]

Bonjour,

Je cherche à dénombrer le nombre d'occurrence de deux cellules distinctes sur les lignes d'un tableau.
Par exemple, il s'agit de savoir combien d'élèves ont opté pour une double spécialité Maths et Physique-Chimie (peu importe l'ordre) dans ce tableau de 4 colonnes à partir de leurs choix de questions pour le Grand Oral (baccalauréat 2021)
Voici respectivement mon code qui ne fonctionne pas, étant novice en VBA, et une capture d'écran du tableau Excel qui sera plus explicite. Le bouton qui appelle les lignes de codes est positionné sur la cellule (4, 14)
Je vous remercie par avance pour toute piste de solution.

Bien cordialement,
Omkara.

Sub NombreSpeTerm()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim n As Integer

i = 0
j = 0
k = 0
n = 0

Line: For j = (n + 2) To 137
For k = 6 To 9
If (Cells(j, k) = Cells(5, 12).Value) Then
For i = 6 To 9
If (Cells(j, i) = Cells(5, 13).Value) Then
n = n + 1
GoTo Line:
End If
Next i
End If
Next k
Next j

Cells(5, 14) = n

End Sub

 

[soan]

Bonjour Omkara,

bienvenue sur le site XLD ! 🙂

pour cette fois, j'ai fait ton exo à partir de ton image .jpg, mais la prochaine fois, j'prendrai pas la peine de recopier toutes tes données : ce sera à toi de joindre un fichier Excel plutôt qu'une image ! je suis sûr que beaucoup de contributeurs n'ont même pas cherché à te répondre à cause de ça ! 😕 tu as eu d'la chance : c'est uniquement car y'avait pas trop d'données à recopier, et qu'c'était pas trop long à faire, que j'ai accepté de faire ton exo ! sans ça, j'aurais laissé tomber !​

---

en I5, choisis une des 2 matières ; en J5 : idem ; fais Ctrl e, ou clique sur le bouton "Effectif" ; K5 restera vide si I5 ou J5 est vide, ou si I5 = J5 (tu as choisi 2 matières identiques) ; si tu as choisi 2 matières différentes, alors l'effectif correspondant aux 2 spécialités s'affichera en K5 (quelque soit leur ordre) ; à toi de faire tous les tests nécessaires.​

Option Explicit

Sub Effectif()
  Dim n&: n = Cells(Rows.Count, 1).End(3).Row: If n = 1 Then Exit Sub
  Application.ScreenUpdating = 0: [K5] = ""
  If [I5] = "" Or [J5] = "" Then Exit Sub
  If [I5] = [J5] Then Exit Sub
  Dim MT$(1), t%, i&, j As Byte, k As Byte
  MT(0) = [I5]: MT(1) = [J5]
  For i = 2 To n
    For j = 3 To 5 Step 2
      With Cells(i, j)
        For k = 0 To 1
          If .Value = MT(k) And .Offset(, 1) = MT(1 - k) Then t = t + 1
        Next k
      End With
    Next j
  Next i
  [K5] = t
End Sub

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis. 😉

soan

 

[Omkara]

Bonsoir Soan,

Merci de t'être penché sur mon problème et la rapidité de ta réponse est appréciée. Je penserai désormais à joindre le fichier Excel.

Bien cordialement,
Omkara