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 !
Sub Macro2()
Dim O As Object 'déclare la variable O (Onglet)
Dim PJ As Range 'déclare la variable PJ (Plage Jaune)
Dim PB As Range 'déclare la variable PB (Plage Bleue)
Dim LI As Byte 'déclare la variable LI (Ligne)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim CJ As Range 'déclare la variable CJ (Cellule Jaune)
Dim CB As Range 'déclare la variable O (Cellule Bleue)
Dim TJ As Integer 'déclare la variable TJ (Total Jaune)
Dim TB As Integer 'déclare la variable TB (Total Bleu)
Set O = Sheets("Feuil1") 'définit l'onglet O
Set PJ = O.Range("F5:K5") 'définit la plage PJ
Set PB = O.Range("L5:P5") 'définit la plage PB
For LI = 6 To 20 'boucle 1 : sur les lignes 6 à 20
TJ = 0: TB = 0 'réinitalise les totaux TJ et TB
For Each CEL In O.Range(O.Cells(LI, 1), O.Cells(LI, 5)) 'boucle 2 : sur toutes les cellules CEL des colonnes 1 (=A) à 5 (=E) de la ligne LI
For Each CJ In PJ 'boucle 3 : sur toutes les cellules CJ de la plage PJ
If CEL.Value = CJ.Value Then TJ = TJ + 1 'si les cellue sont identiques incrémente le total TJ
Next CJ 'prochaine cellule de la boucle 2
For Each CB In PB 'boucle 4 : sur toutes les cellules CB de la plage PB
If CEL.Value = CB.Value Then TB = TB + 1 'si les cellue sont identiques incrémente le total TB
Next CB 'prochaine cellule de la boucle 4
Next CEL 'prochaine cellule de la boucle 2
O.Cells(LI, 6).Value = CStr(TJ) & CStr(TB) 'dans la colonne F de la ligne LI, renvoie le total TJ concatené avec le total TB
Next LI 'prochaine ligne de la boucle 1
End SubSub Macro3()
Application.ScreenUpdating = False
Range("F6").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT(COUNTIF(RC[-5]:RC[-1],R5C6:R5C11))&"" ""&SUMPRODUCT(COUNTIF(RC[-5]:RC[-1],R5C12:R5C16))"
Range("F6").Select
Selection.AutoFill Destination:=Range("F6:F20")
Range("F6:F20").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.ScreenUpdating = True
End Sub
Function Calcul$(r, r1, r2)
Dim x, y, p As Byte, q As Byte
r = r: r1 = r1: r2 = r2 'matrices, plus rapides
For Each x In r
For Each y In r1
If x = y Then p = p + 1
Next
For Each y In r2
If x = y Then q = q + 1
Next
Next
Calcul = p & q
End Function
Sub Macro3()
Application.ScreenUpdating = False
[F6:F20].FormulaR1C1 = _
"=SUMPRODUCT(COUNTIF(RC[-5]:RC[-1],R5C6:R5C11))&"" ""& SUMPRODUCT(COUNTIF(RC[-5]:RC[-1],R5C12:R5C16))"
'pour ne plus avoir de formules gourmandes en durée (beaucoup de lignes)*
[F6:F20] = [F6:F20].Value
End Sub
