Staple1600
XLDnaute Barbatruc
Bonsoir le forum
Je séche sur ce petit problème
Je voudrais concaténer des nombres (dans l'exemple de 1 à 16) selon la valeur d'une cellule.
J'y suis presque.
La particularité, c'est que quand les nombres sont consécutifs, la valeur retournée soit par exemple
1 à 16 (au lieu de 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16)
2 à 8 (au lieu de 2,3,4,5,6,7,8)
Ce code ci-dessous reflète mes essais en l'état.
Je pense qu'il y a beaucoup plus simple comme syntaxe.
NB: je joindrai des données exemples plus tard car je dois m'absenter pour le repas de Noel de ma boite qui commençait à 19h.
Heureusement qu'il y a le métro.
Je séche sur ce petit problème
Je voudrais concaténer des nombres (dans l'exemple de 1 à 16) selon la valeur d'une cellule.
J'y suis presque.
La particularité, c'est que quand les nombres sont consécutifs, la valeur retournée soit par exemple
1 à 16 (au lieu de 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16)
2 à 8 (au lieu de 2,3,4,5,6,7,8)
Ce code ci-dessous reflète mes essais en l'état.
Je pense qu'il y a beaucoup plus simple comme syntaxe.
NB: je joindrai des données exemples plus tard car je dois m'absenter pour le repas de Noel de ma boite qui commençait à 19h.
Heureusement qu'il y a le métro.
VB:
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
Dernière édition: