Comptabiliser des occurrences dans 10 colonnes

**MP5078** · 20/07/2012, 18h10

Bonjour

Je cherche la formule permettant de comptabiliser des occurrences dans un espace contigu de 10 colonnes
deux cas à considérer : 5 ou plus de 5 dans 10 colonnes contiguës ; le résultat es OK et on note la quantité en K14
Moins de 5 alors le résultat en K14 devient 0
Classeur joint avec principaux exemples
Merci d'avance pour votre aide

**Bear the french** · 20/07/2012, 20h58

Bonsoir MP5078,

Colles cette macro dans l'onglet "Feuil1" :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
36
37
38
39
40
41
42
43
44
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Plage de recherche = A3:U3
' Résultat en K5
 
'déclaration des variables
Dim tablo1(20), tablo2(11), somme_10_colonnes, i, j, le_plus_eleve As Integer
 
'déclenchement de la macro si changement sur les cellules concernées
If Not Intersect(Target, Range("B3:U3")) Is Nothing Then
 
        'initialisation des variables
        somme_10_colonnes = 0
        le_plus_eleve = 0
 
        'on rentre chacune des 20 cellules dans un tableau variable VBA
        For i = 2 To 21
            tablo1(i - 2) = Worksheets("Feuil1").Cells(3, i).Value
        Next
 
        'on somme 10 occurences et on loge les sommes dans un deuxième tableau
        For i = 0 To 11 'on décale/glisse d'un rang vers la droite
            For j = i To i + 8 '10 colonnes qui se suivent (ex : 0-1-2-3-4-5-6-7-8)
                    somme_10_colonnes = somme_10_colonnes + tablo1(j)
            Next
            tablo2(i) = somme_10_colonnes
            somme_10_colonnes = 0
        Next
 
        'on cherche la somme de 10 colonnes consécutives la valeur la plus élevée
        For i = 0 To 11
                If tablo2(i) >= le_plus_eleve Then
                    le_plus_eleve = tablo2(i)
                End If
        Next
 
        '5 ou plus de 5 dans 10 colonnes contiguës --> on note la quantité en K5
        'Moins de 5 alors le résultat en K5 devient 0
        If le_plus_eleve < 5 Then
            Worksheets("Feuil1").Range("K5").Value = 0
        Else
            Worksheets("Feuil1").Range("K5").Value = le_plus_eleve
        End If
End If
End Sub

C'est paramétré pour une plage de recherche = A3:U3 et le résultat est affiché en K5. A modifier si nécessaire.

J'ai commenté pour plus compréhension.

Bertrand

**mercatog** · 20/07/2012, 23h37

Ci-joint une fonction personnalisée à mettre dans un module standard

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Function NBR(ByVal Rng As Range) As Double
Dim i As Integer
Dim S As Double
Dim Tb
 
Tb = Rng.Value
For i = 1 To 20
    S = Som(Tb, i)
    If S >= 5 Then
        NBR = S
        Exit For
    End If
Next i
End Function
 
Private Function Som(ByVal Tablo, ByVal j As Integer) As Double
Dim k As Integer, m As Integer
Dim T As Double
 
If Tablo(1, j) <> 0 Then
    m = Application.Min(20, j + 9)
    For k = j To m
        T = T + Tablo(1, k)
    Next k
    Som = T
End If
End Function