Fonction rang a partir de plusieurs plages de comparaison

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

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

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

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