Function CONCATSI(CriteriaRange As Range, Condition As Variant, ConcatenateRange As Range, Optional Separator As String = ",") As Variant
Dim xResult As String, i, t, x, aa, bb, zz$
aa = Array(6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16)
bb = Array(21, 28, 36, 45, 55, 66, 78, 91, 105, 120, 136)
On Error Resume Next
If CriteriaRange.Count <> ConcatenateRange.Count Then
CONCATSI = CVErr(xlErrRef)
Exit Function
End If
For i = 1 To CriteriaRange.Count
If CriteriaRange.Cells(i).Value = Condition Then
xResult = xResult & Separator & ConcatenateRange.Cells(i).Value
End If
Next i
If xResult <> "" Then
'x = VBA.Mid(xResult, 2, Len(xResult) - 1)
'Debug.Print x
t = Split(xResult, ",")
If UBound(t) > 5 And Len(xResult) > 1 And (t(UBound(t)) - 1) / (UBound(t) - 1) = 1 Then
xResult = "1 à " & Application.Index(aa, Application.Match((UBound(t) * (1 + UBound(t)) / 2), bb, 0))
Else
'xResult = VBA.Mid(xResult, VBA.Len(Separator) + 1)
'MsgBox Len(xResult) & "o"
xResult = VBA.Mid(xResult, 2, VBA.Len(xResult) + 1)
End If
End If
CONCATSI = xResult
'Exit Function
End Function