XL 2010 Nb cellule entre chaque valeur identique

[chokili20]

Bonsoir,

Une demande pour calculer combien il y'a de cellule entre chaque valeur identique.
Par exemple, sur une ligne, entre chaque "2" combien y'a t il de cellule (1 puis 4 puis 3 puis 1 puis 2 etc...)
Attention, tableau avec des #N/A.

Je n'ai pas tout mis, mais tableau conséquent donc VBA ou pas je veux bien tout tester.

Merci à vous tous

 

[Bebere]

bonjour
voilà un code à adapter si plus de données

 

[job75]

Bonjour chokili20, Bebere,

Utilisation de cette fonction VBA matricielle dans le fichier joint :

Function Nentre(t, x%)
Dim ub%, i%, y As Variant, j%, n%
t = t 'matrice, plus rapide
ub = UBound(t, 2)
For i = 1 To ub
    y = t(1, i)
    If IsNumeric(y) Then
        If y = x Then
            For j = i + 1 To ub
                y = t(1, j)
                If IsNumeric(y) Then
                    If y = x Then
                        If j > i + 1 Then n = n + 1: t(1, n) = j - i - 1
                        i = j - 1
                        Exit For
                    End If
                End If
            Next j
        End If
    End If
Next i
ub = Application.Min(Application.Caller.Count, ub)
For i = n + 1 To ub: t(1, i) = "": Next i
Nentre = t 'matrice ligne
End Function

Sélectionner BA3:BK3, entrer la formule dans la barre de formule et valider en bloc matriciellement par Ctrl+Maj+Entrée.

Copier BA3:BK3 et Collage spécial-Formules vers les plages BA4:BK29 - BL3:BV29 - BW3:CG29.

A+

 

[job75]

Re,

J'ai comparé les 2 solutions sur la plage BA3:BK29 :

- Bebere 2,4 millisecondes

- job75 2,8 millisecondes.

A+

 

[job75]

Re,

Avec cette variante le calcul précédent prend seulement 1,8 milliseconde :

Function Nentre(t, x%)
Dim ub%, a(), i%, y As Variant, j%, n%
t = t 'matrice, plus rapide
ub = UBound(t, 2)
ReDim a(1 To Application.Caller.Count)
For i = 1 To ub
    y = t(1, i)
    If IsNumeric(y) Then
        If y = x Then
            For j = i + 1 To ub
                y = t(1, j)
                If IsNumeric(y) Then
                    If y = x Then
                        If j > i + 1 Then n = n + 1: a(n) = j - i - 1
                        i = j - 1
                        Exit For
                    End If
                End If
            Next j
        End If
    End If
Next i
Nentre = a 'vecteur ligne
End Function

Pour masquer les valeurs zéro les tableaux des résultats doivent être mis au format personnalisé 0;;

Fichier (2).

A+

 

[chokili20]

Bonsoir le forum, Bebere, job75,

J'ai regardé les propositions et ça me convient, en effet c'est assez rapide.
Merci

 

[chokili20]

Bonsoir à tous,
Je remonte ce sujet car j'ai une nouvelle question.
La 1e fois ma demande concernait les écarts des valeurs sur une ligne.
Cette fois ci je voudrais calculer les écarts sur une colonne.
J'ai repris la solution de job75 (merci encore), mais je ne sais comment faire car c'est du VBA.
J'ai fait un essai en adaptant la formule et ça ne va pas.
Voici un tableau avec en feuille 2 ma demande.
Merci

 

[job75]

Bonsoir chokili20,

Utilisez cette nouvelle fonction :

Function Nentre2(t, x%)
Dim ub%, a(), i%, y As Variant, j%, n%
t = t 'matrice, plus rapide
ub = UBound(t)
ReDim a(1 To Application.Caller.Count, 1 To 1)
For i = 1 To ub
    y = t(i, 1)
    If IsNumeric(y) Then
        If y = x Then
            For j = i + 1 To ub
                y = t(j, 1)
                If IsNumeric(y) Then
                    If y = x Then
                        If j > i + 1 Then n = n + 1: a(n, 1) = j - i - 1
                        i = j - 1
                        Exit For
                    End If
                End If
            Next j
        End If
    End If
Next i
Nentre2 = a 'vecteur colonne
End Function

Fichier (3).

A+

 

[chokili20]

Bonsoir job75,
C'est parfait et rapide comme d'habitude.
Merci