XL 2016 Formule "RANG" dans un tableau (compter plusieurs cellule suivant condition)

RobyL · 6 Septembre 2023

Bonjour à tous,

je sollicite votre aide pour un pb de formules :

je connais la formule pour une ligne de pris en compte : =SIERREUR(RANG([@D];Tableau1[@[D]:[T]];1);"")
mais je souhaite ajouter une condition :
SI LA COLONNE "A" contient plusieurs fois le même nombre alors je souhaite que le calcul de rang s'effectue sur les lignes correspondantes au même numéro de la colonne "A".

je sens que ce n'est pas très claire. je joint un fichier pour plus d'explication.
je vous remercie d'avance pour votre aide.

job75 · 6 Septembre 2023

Bonjour Robyl,

Voyez le fichier .xlsm joint et cette fonction VBA :

VB:

Function UnionPlage(ref As Range, plage As Range) As Range
Dim colonne As Range, i&
Set colonne = Intersect(ref.EntireColumn, plage.EntireRow).Cells
For i = 1 To plage.Rows.Count
    If colonne(i) = ref Then Set UnionPlage = Union(IIf(UnionPlage Is Nothing, plage.Rows(i), UnionPlage), plage.Rows(i))
Next
End Function

Le code doit être impérativement dans un module standard.

Formule en F2 à tirer à droite et vers le bas :

Code:

=SIERREUR(RANG(B2;UnionPlage($A2;Tableau1[[D]:[T]]);1);"")

A+

job75 · 6 Septembre 2023

Bonjour Robyl,

Voyez le fichier .xlsm joint et cette fonction VBA :

VB:

Function UnionPlage(ref As Range, plage As Range) As Range
Dim colonne As Range, i&
Set colonne = Intersect(ref.EntireColumn, plage.EntireRow).Cells
For i = 1 To plage.Rows.Count
    If colonne(i) = ref Then Set UnionPlage = Union(IIf(UnionPlage Is Nothing, plage.Rows(i), UnionPlage), plage.Rows(i))
Next
End Function

Le code doit être impérativement dans un module standard.

Formule en F2 à tirer à droite et vers le bas :

Code:

=SIERREUR(RANG(B2;UnionPlage($A2;Tableau1[[D]:[T]]);1);"")

A+

RobyL · 7 Septembre 2023

Bonjour merci beaucoup.
ça marche nickel.

si j peux me permettre d'ajouter une chose.
la vitesse de traitement est un peut longue car j'ai 400 lignes à gérer.
auriez vous une idée pour rendre le traitement moins lourd ?

job75 · 7 Septembre 2023

Bonjour Robyl,

Oui la méthode Union prend du temps dès qu'i y a plus d'une centaine de plages disjointes à unir.

Pour tester le fichier du post #2 j'ai :

- supprimé les formules de liaisons en colonnes A:E

- supprimé la MFC en colonne A

- recopié la plage A2:I7 sur 420 lignes.

Chez moi les formules en colonnes F:I se recalculent en 5,8 secondes.

En triant tout le tableau sur la colonne A le recalcul se fait en 4,8 secondes, le gain est réel mais peu important.

PS : pour que les fonctions UnionPlage se recalculent je les ai rendues volatiles.

A+

job75 · 7 Septembre 2023

En utilisant un tableau VBA (matrice) dans le code de la fonction :

VB:

Function UnionPlage(ref As Range, plage As Range) As Range
Dim a, x, i&
a = Intersect(ref.EntireColumn, plage.EntireRow).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
x = ref
For i = 1 To UBound(a)
    If a(i, 1) = x Then Set UnionPlage = Union(IIf(UnionPlage Is Nothing, plage.Rows(i), UnionPlage), plage.Rows(i))
Next
End Function

la durée est nettement réduite sur 420 lignes :

- 3,1 secondes au lieu de 5,8 secondes

- 2,2 secondes au lieu de 4,8 secondes (tableau trié)

Donc utilisez cette fonction.

job75 · 7 Septembre 2023

Pour aller plus vite il ne faut pas utiliser la méthode Union.

Dans ce fichier (2) cette fonction VBA remplace la fonction RANG et traite tout par des tableaux :

VB:

Function XRANG(refRang As Range, ref As Range, plage As Range) As Long
Dim a, b, ncol%, x, i&, j%, v, c(), n&
a = Intersect(ref.EntireColumn, plage.EntireRow).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
b = plage
ncol = UBound(b, 2)
x = ref
For i = 1 To UBound(a)
    If a(i, 1) = x Then
        For j = 1 To ncol
            v = b(i, j)
            If IsNumeric(CStr(v)) Then
                ReDim Preserve c(n)
                c(n) = v
                n = n + 1
            End If
        Next j
    End If
Next i
tri c, 0, n - 1
XRANG = Application.Match(refRang, c, 0)
End Function

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub

Testé sur 420 lignes le recalcul s'effectue maintenant en 1,6 seconde.

RobyL · 8 Septembre 2023

Bonjour,

Merci pour toutes ces solutions. quel travail WOUAOU !!

Lorsque j'applique ceci à mon fichier de base le temps est raccourcit mais il se recalcule fréquemment.
J'ai 17 colonne qui prenne un numéro via un renvoie type : =SI('X'!AF7=0;"";'X'!AF7)
C'est par rapport à ce numéro que le calcul est fait. il y a donc 2 tableaux. 1 principale et 1 où je fait ce calcul.
A chaque fois que j'incrémente mon tableau j'ai donc (à peut prés) 10 sec d'attente.
Cela rend toujours le fichier très lent au finale.

Encore merci pour l'investissement de votre part je ne pensais pas trouver autant d'appuis ici et aussi vite.

job75 · 8 Septembre 2023

Bonjour RobyL,

Voici qui est beaucoup plus rapide mais nettement plus difficile à comprendre :

VB:

Public d As Object 'mémorise la variable

Function XRANG(refRang As Range, ref As Range, plage As Range)
If refRang = "" Then XRANG = "": Exit Function
Dim x, a, b, ncol%, i&, j%, v, c(), n&
x = ref
If d Is Nothing Then Set d = CreateObject("Scripting.Dictionary")
If Not d.exists(x) Then
    a = Intersect(ref.EntireColumn, plage.EntireRow).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    b = plage
    ncol = UBound(b, 2)
    For i = 1 To UBound(a)
        If a(i, 1) = x Then
            For j = 1 To ncol
                v = b(i, j)
                If IsNumeric(CStr(v)) Then
                    ReDim Preserve c(n)
                    c(n) = v
                    n = n + 1
                End If
            Next j
        End If
    Next i
    tri c, 0, n - 1
    d(x) = c 'mémorise l'Array
End If
XRANG = Application.Match(refRang, d(x), 0)
End Function

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub

et ajouter dans le code de la feuille :

VB:

Private Sub Worksheet_Calculate()
Set d = Nothing 'RAZ de la variable
End Sub

Sur 420 lignes le recalcul se fait en 0,08 seconde...

A+

RobyL · 12 Septembre 2023

Bonjour,
Merci encore pour avoir travailler sur une version plus optimiser.
Cette variante fonctionne bien mais le temps est toujours de 5 à 6 secondes pour moi.
Elle est donc meilleurs mais pas aussi rapide que la formule "rang" qui est peut être d'une seconde.

job75 · 12 Septembre 2023

Bonjour RobyL,

Je viens de modifier la fonction du post #8 en ajoutant :

VB:

If refRang = "" Then XRANG = "": Exit Function

Cela permet d'éviter SIERREUR et de gagner un petit peu de temps.

A part ça je ne vois pas comment aller plus vite.

Ce qui m'intrigue c'est quand vous dites qu'il y a 2 tableaux alors qu'il n'y a qu'un seul tableau structuré.

A+

RobyL · 12 Septembre 2023

Effectivement j'ai en réalité 2 tableaux.
Un premier tableau de données à plusieurs colonnes. Je ne peut pas effectuer le calcul des rang car les cellules sur lesquelles je veux la fonction ne se situe pas cote à cote. Du coup j'utilise une formule de renvoi dans un autre tableau d'une autre feuille. Formule type =D7.
Quand je fait ceci avec la formule rang le calcul est extrêmement rapide malgré 17 colonnes et 400 lignes.
Voilà l'explication.
J'ai demandé de l'aide à chatgpt mais il ne m'a pas apporté des solutions viables. Vous êtes bien plus performant

job75 · 12 Septembre 2023

Il faudrait joindre votre fichier réel avec quelques lignes car je pense qu'il faut adapter ma solution.

RobyL · 14 Septembre 2023

Bonjour,

Je joint une partie de mon fichier.
Dés que je filtre la colonne "affaire" les formules ne suivent plus. ça met des erreurs.
Merci encore pour votre aide.

job75 · 14 Septembre 2023

Bonjour RobyL,

Plutôt que le filtre automatique utilisez le filtre avancé :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C5:D5]) Is Nothing Then Exit Sub
Application.Calculation = xlCalculationManual
[E5] = "=IF(C$5="""",1,C7=C$5)*IF(D$5="""",1,D7=D$5)" 'critère de filtrage
ListObjects(1).Range.AdvancedFilter xlFilterInPlace, [E4:E5] 'filtre avancé
[E5] = ""
Application.Calculation = xlCalculationAutomatic
End Sub

A+

job75 · 14 Septembre 2023

Concernant le recalcul en Feuil1 il y avait des formules parasites entre les lignes 451 et 1186.

J'ai supprimé ces lignes.

Maintenant la revalidation de la cellule S2, qui entraine le recalcul des cellules S2:AI450, se fait chez moi en 0,5 seconde, c'est très acceptable.

XL 2016 Formule "RANG" dans un tableau (compter plusieurs cellule suivant condition)

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Junior

XLDnaute Barbatruc

Pièces jointes

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

Discussions similaires