XL 2019 Couplé mixte un pair un impair

  • Initiateur de la discussion Initiateur de la discussion Hoareau
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Hoareau

XLDnaute Occasionnel
Bonjour

Je voudrais les couplés mixtes un pair, un impair
Compteur_Mixte est sensé me donner cela, mais le comte n'est pas bon

merci

If N_1 Mod 2 = 0 And N_2 Mod 2 = 0 Then
Compteur_Pair = Compteur_Pair + 1
c.Offset(0, 5) = 1 'Compteur_Pair
End If
If N_1 Mod 2 <> 0 And N_2 Mod 2 <> 0 Then
Compteur_Impairs = Compteur_Impairs + 1
c.Offset(0, 6) = 1 'Compteur_Impairs
End If
If N_1 Mod 2 = 0 Or N_2 Mod 2 = 0 Then
Compteur_Mixte = Compteur_Mixte + 1
c.Offset(0, 7) = 1 ' Compteur_Mixte
End If
 

Pièces jointes

Bonjour.
Je pense que je l'écrirais comme ça :
VB:
Option Explicit
Sub StatsCoup20P()
   Dim RngDon As Range, TDon(), TDét(), L As Long
   Set RngDon = [C5].Resize([C1000000].End(xlUp).Row - 4, 2)
   TDon = RngDon.Value
   ReDim TDét(1 To UBound(TDon, 1), 1 To 3)
   For L = 1 To UBound(TDon, 1)
      TDét(L, IIf((TDon(L, 1) + TDon(L, 2)) Mod 2, 3, TDon(L, 1) Mod 2 + 1)) = 1
      Next L
   With Intersect([H:J], RngDon.EntireRow)
      .Value = TDét
      [H3:J3].FormulaR1C1 = "=SUM(" & .Columns(1).Address(True, False, xlR1C1, False, .Columns(1)) & ")"
      End With
   [K3].FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
   End Sub
 
Ne sachant pas à qui vous vous adressiez, un ex en PJ avec la fonction :
VB:
Function Stat(Plage As Range, TypeStat As String)
Dim Pair As Integer, Impair As Integer, Mixte As Integer, tablo
Pair = 0: Impair = 0: Mixte = 0
tablo = Plage
For c = 1 To UBound(tablo)
N_1 = tablo(c, 1)
N_2 = tablo(c, 2)
If (N_1 And 1) And (N_2 And 1) Then
    Pair = Pair + 1
ElseIf (N_1 And 1) = 0 And (N_2 And 1) = 0 Then
    Impair = Impair + 1
Else
    Mixte = Mixte + 1
End If
Next
Select Case TypeStat
    Case "Pair"
        Stat = Pair
    Case "Impair"
        Stat = Impair
    Case "Mixte"
        Stat = Mixte
    Case "Total"
        Stat = Pair + Impair + Mixte
    Case Else
        Stat = "Erreur"
End Select
End Function
 

Pièces jointes

Bonjour
C'est presque que cela, j'aurai souhaité :
1) que la sortie se fasse en bloc, pour l'affichage sur la feuille
ex: tabl_2(Pair, Impair, Mixte)
2) Ne pas mettre typstat, de façon à avoir les trois décomptes affichés ensembles
Mais cette version m'intéresse aussi

J'ai aussi constaté, voir feuille, que si les couplés ne sont pas complets ou si blanc dans cellules de la plage, le décompte est faux
La plage de référence n'est pas sensée avoir des vides, mais fonction destinée à une boucle sur un grand nombre de lignes, qui peuvent avoir des anomalies

merci
 

Pièces jointes

Bonjour,
Une fonction ne peut pas modifier autre chose que la cellule qui l'appelle, ou du moins je ne connais pas.
Ensuite, si la matrice a des erreurs, alors le résultat est erroné. 😉
Là non plus je ne sais pas comment faire. Sauf à remonter Erreur si une cellule est vide, si elle est négative, si elle a un caractère alpha ...
Pour les cellules vides vous pouvez rajouter ces 4 lignes de codes :
VB:
N_1 = tablo(c, 1)
N_2 = tablo(c, 2)
'-----Sécurisation si vide
If N_1 = "" Or N_2 = "" Then
    Stat = "Erreur"
    End Function
End If
 
pas pu répondre plus tôt, c'est déjà beaucoup
merci



Bonjour,
Une fonction ne peut pas modifier autre chose que la cellule qui l'appelle, ou du moins je ne connais pas.
Ensuite, si la matrice a des erreurs, alors le résultat est erroné. 😉
Là non plus je ne sais pas comment faire. Sauf à remonter Erreur si une cellule est vide, si elle est négative, si elle a un caractère alpha ...
Pour les cellules vides vous pouvez rajouter ces 4 lignes de codes :
VB:
N_1 = tablo(c, 1)
N_2 = tablo(c, 2)
'-----Sécurisation si vide
If N_1 = "" Or N_2 = "" Then
    Stat = "Erreur"
    End Function
End If
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
580
Réponses
5
Affichages
477
Réponses
10
Affichages
531
Réponses
7
Affichages
360
Retour