[VBA UDF] Concaténation particulière

[Staple1600]

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.

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

 

[Staple1600]

Bonsoir eriiiic

J'ai modifié ceci
concat = Mid(concat, 2)
Sinon je n'avais pas le premier élément.

Merci d'avoir éclairée ma lanterne.

Sans l'erreur, je suppose, du 10 au lieu du 11 ?

Oui désolé, erreur de saisie manuelle.

Maintenant savoir quelle fonction il faut privilégier, je vous compte sur vous pour me le dire

NB: Je vous rappelle que je serai pas l'utilisateur final de cette fonction.
J'espère d'ailleurs que ma collègue saura l'utiliser sans se tromper

 

[eriiic]

Ah oui. J'ai ajouté le paramètre Separator mais oublié cette partie. Merci

concat = Mid(concat, Len(Separator) + 1)

pour rester général

 

[Staple1600]

Re

Une dernière copie écran en guise comparatif
(en vert le bon affichage)

 

[Staple1600]

Re

En attendant David Gilmour sur Arte, je me suis permis de "customiser" ta fonction
Avec comme syntaxe d'utilisation:
=concatB($B$2:$B$23;B2;$A$2:$A$23;"/";6)
ou
=concatB($B$2:$B$23;B2;$A$2:$A$23;",";4)

Function concatB(CriteriaRange As Range, Condition As Variant, ConcatenateRange As Range, Separator As String, Optional nb As Long = 4) As String
    Dim i As Long, j As Long, pl As Range, pl2 As Range, tmp
    Dim critR, cond, ConcatR
    critR = CriteriaRange.Value: cond = Condition.Value: ConcatR = ConcatenateRange.Value
    For i = 1 To UBound(critR)
        If critR(i, 1) = cond Then
            If pl Is Nothing Then
                Set pl = Rows(ConcatR(i, 1))
            Else
                Set pl = Union(pl, Rows(ConcatR(i, 1)))
            End If
        End If
    Next i
    For Each pl2 In pl.Areas
        If pl2.Rows.Count >= nb Then
            concatB = concatB & Separator & Replace(pl2.Address(0, 0), ":", " à ")
        Else
            tmp = Split(pl2.Address(0, 0), ":")
            For j = tmp(0) To tmp(1)
                concatB = concatB & Separator & j
            Next j
        End If
    Next pl2
    concatB =  Mid(concatB, Len(Separator) + 1)
End Function

 

[eriiic]

Bizarre...
mon fichier que tu vois.
Si tu vois un truc bizarre traîner ne t'étonne pas. J'ai utilisé ensuite ce classeur. Normalement j'ai tout nettoyé mais j'ai pu oublier un truc dans un coin...

Edit : ah, tu l'as faite fonctionner finalement, ou j'avais mal compris peut-être
oui, pas plus mal que l'utilisateur ait accès à ce paramètre.

 

[Staple1600]

Re

@eriiiic
Excuse-moi, il y avait une coquille dans mes modifs
(j'ai donc édité mon message#33) puis posté le #34 où la customisation fonctionne.

Désolé de ce contretemps pour toi.

 

[Staple1600]

Bonsoir le fil, le forum

En attendant les outrages lipidiques et glucides du réveillon, j'ai creusé cette histoire de concaténation, et je suis tombé sur ce genre de syntaxe (que j'ai déjà lu ici sur XLD notamment dans les codes de klin89)
Donc je poste le résultat de ma récréation du jour

    Function CONCATSI(Condition, rng As Range, rng2 As Range, Optional Sep As String = ",")
    If Not IsNumeric(Condition) Then Condition = Chr(34) & Condition & Chr(34)
    With rng
    CONCATSI = _
    Join(Filter(.Parent.Evaluate("TRANSPOSE(IF(" & .Columns(1).Address & "=" & Condition & "," & rng2.Address & "))"), False, 0), Sep)
    End With
    End Function

La syntaxe d'utilisation étant par exemple : =concatsi(B2;$B$2:$B$13;$A$2:$A$13)
(avec en colonne A les NUM et colonne B les ITEMS comme dans l'exemple en début de fil)
Le problème c'est qu'avec ce joli et concis code, je concatène certes mais comme au début de ce fil.
Et là j'ai de nouveu besoin de vos lumières pour ajouter le raccourci N1 à Nx
(comme le faisait vos dernières propositions)
Le challenge étant si possible sur une seule ligne de code
(ce que je ne vois pas comment faire actuellement)

Sinon que pensez-vous de ce genre de syntaxe que je vois rarement sur XLD ( à part chez klin89) ?

[up+1]

 

[Dranreb]

Sinon que pensez-vous de ce genre de syntaxe

Personnellement
TR = Filter(.Parent.Evaluate("TRANSPOSE(IF(" & .Columns(1).Address & "=" & Condition & "," & rng2.Address & "))"), False, 0)
me paraît plus obscur que :
TCrit = .Columns(1).Value: TConc = rng2.value
For L = 1 To UBound(TCrit, 1)
If TCrit(L, 1) = Condition Then
N = N + 1: ReDim Preserve TR(1 To N): TR(N) = TConc(L, 1): End If: Next L

 

[Staple1600]

Bonsoir Dranreb

C'est également obscur pour moi
Ce qui m'interpelle le plus c'est l'utilisation conjointe de Join et Filter.
J'ai l'impression que cela semble offrir pas mal de possibilité, non?
Mais avec un réveillon dans les pattes, je ne suis pas en mesure de poursuivre plus loin ce soir.
Bonne nuit à tous et bonne fin de reveillon