Fonction rang a partir de plusieurs plages de comparaison

[Niouf]

Bonjour le forum !

Dites moi, est il possible d'utiliser la function rang a partir de plusieurs plages de comparaison ?
Exemple : la formule fonctionne tres bien si je compare une valeur de la colonne A a l'ensemble des valeurs de cette colonne A.
Par contre, je n'arrive pas a l'utiliser lorsque je veux comparer seulement une case sur deux de cette colonne A.

Avez vous des pistes pour contourner le problem ?

Voir fichier joint

 

[job75]

Bonjour Niouf,

Voyez le fichier joint et les explications qui s'y trouvent.

Vous avez bien dit "par rapport a l'ensemble des cellules pas en gras".

A+

 

[job75]

Re,

Une solution par fonction VBA qui ne nécessite pas de colonnes auxiliaires :

Function RangNonGras(ref As Range, plage As Range)
'plage a une colonne (ou une ligne)
Application.Volatile
If ref.Font.Bold Then RangNonGras = "": Exit Function
Dim a(), i&
Set plage = Intersect(plage, Application.Caller.Parent.UsedRange)
ReDim a(1 To plage.Count)
For i = 1 To UBound(a)
  a(i) = IIf(IsNumeric(CStr(plage(i))) And Not plage(i).Font.Bold, plage(i), -1E+99)
Next
tri a, 1, UBound(a)
RangNonGras = Application.Match(ref, a, 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

Fichier joint.

A+

 

[job75]

Re,

Le recalcul des formules prend beaucoup plus de temps avec la 2ème solution :

- post #2 => 0,4 millième de seconde

- post #3 => 91 millièmes de seconde

sur Win 10 - Excel 2013.

A+

 

[job75]

Bonjour Niouf, le forum,

Pour accélérer le recalcul :

Public d As Object 'mémorisation, RAZ dans la Worksheet_Calculate

Function RangNonGras(ref As Range, plage As Range)
'plage a une colonne
Application.Volatile
Dim col%, a#(), i&, x
col = plage.Column
If d Is Nothing Then Set d = CreateObject("Scripting.Dictionary")
If Not d.exists(col) Then
  Set plage = Intersect(plage, plage.Parent.UsedRange)
  ReDim a(1 To plage.Count)
  For i = 1 To UBound(a)
    x = plage(i)
    a(i) = IIf(IsNumeric(CStr(x)) And Not plage(i).Font.Bold, x, -1E+99)
  Next
  tri a, 1, UBound(a)
  d(col) = a 'mémorisation du tableau dans l'item
End If
If IsNumeric(CStr(ref)) And Not ref.Font.Bold Then RangNonGras = Application.Match(ref, d(col), 0) Else RangNonGras = ""
End Function

Le Dictionary est créé à l'ouverture du fichier :

Private Sub Workbook_Open()
Set d = CreateObject("Scripting.Dictionary")
End Sub

et il est vidé après chaque recalcul de la feuille :

Private Sub Worksheet_Calculate()
d.RemoveAll 'RAZ
End Sub

Les colonnes A et C peuvent contenir des cellules vides, des textes ou des valeurs d'erreur.

Fichier (2), chez moi le recalcul se fait maintenant en 7,2 millisecondes.

C'est nettement mieux mais encore 18 fois moins rapide que la version du post #2.

Bonne journée.

 

[Niouf]

Merci a tous pour vos reponses !

Je viens seulement de me pencher a nouveau sur la question.

Donc la derniere proposition fonctionne parfaitement dans mon cas
Cependant, n'est il pas possible d'eviter les macros ? (Avec formules seulement)

Merci.

 

[job75]

Bonsoir Niouf,

Cependant, n'est il pas possible d'eviter les macros ? (Avec formules seulement)

Il vous arrive de suivre vos fils ? Le fichier du post #2 n'utilise que des formules.

Toujours si vous aviez suivi, vous auriez compris que c'est la meilleur solution.

A+