modifier une formule

1 pièce(s) jointe(s)

bonjour,
j ai emprunté une formule à M Boisgontier qui je voudrais affiner.
Actuellement elle agit de B à O et je voudrais la scinder pour agir de B à F en rapport avec K à O ( enjeux:tirage) et de G à H en rapport avec P à Q (bonus:bonus).
je ne sais pas comment formuler les intersections de lignes/ colonnes.
merci de votre aide, je vous joint le fichier.
Pièce jointe 560128

Bonjour,

Essayez ceci
Pièce jointe 560150

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Sub ColoriageDoublonsNbSi()
    Dim Champ1 As String, Champ2 As String
    Dim i As Long
    Application.ScreenUpdating = False
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
    Range(Cells(7, "B"), Cells(DerLig, "Q")).Interior.ColorIndex = xlNone
    For i = 7 To DerLig
        Champ1 = "B" & i & ":F" & i
        Champ2 = "K" & i & ":O" & i
        For Each Cell In Range(Champ1)
            If Application.CountIf(Range(Champ2), Cell) = 1 Then Cell.Interior.ColorIndex = 6
        Next
    Next i
    For i = 7 To DerLig
        Champ1 = "B" & i & ":F" & i
        Champ2 = "K" & i & ":O" & i
        For Each Cell In Range(Champ2)
            If Application.CountIf(Range(Champ1), Cell) = 1 Then Cell.Interior.ColorIndex = 6
        Next
    Next i
    For i = 7 To DerLig
        Champ1 = "G" & i & ":H" & i
        Champ2 = "P" & i & ":Q" & i
        For Each Cell In Range(Champ1)
            If Application.CountIf(Range(Champ2), Cell) = 1 Then Cell.Interior.ColorIndex = 4
        Next
    Next i
    For i = 7 To DerLig
        Champ1 = "G" & i & ":H" & i
        Champ2 = "P" & i & ":Q" & i
        For Each Cell In Range(Champ2)
            If Application.CountIf(Range(Champ1), Cell) = 1 Then Cell.Interior.ColorIndex = 4
        Next
    Next i
 End Sub

Cdlt

modifier une formule

[QUOTE=ARTURO83;11502044]Bonjour,

Essayez ceci
Pièce jointe 560150

merci arturo, cela marche tres bien et comme je voulais