Microsoft 365 Interprétation d'une série de valeur sur une ligne

[bioteau]

Bonjour à tous,

Je penche sur un problème depuis plusieurs jours mais n'y arrive pas. Je précise que je suis novice + en VBA .
Sur une cellule ("U3"), je renvoie les valeurs des checkbox validées (qui correspondent à des numéros de colis) sous forme de string.
"J'éclate" par un SPLIT l'ensemble des valeurs de la cellule ("U3") sur la ligne 3 à partir de la colonne V (22). Ce renvoi peut concerner 70 checkbox c'est à dire jusqu'a la colonne CM (91).
Je voudrais "traduire" cette ligne en concatener dans la cellule (E3)sous la forme suivante :
Tant que les chiffres se suivent (exemple 1,2,3,4...) traduire par "de 1 à 4"
Si les chiffres ne se suivent pas (exemple 1,2,4,7,8,9,10,11...) traduire par "de 1 à 2 et 4 et 7 à 11"
J'ai tenté de faire une boucle For Each Cell in Range sans succès , je n'arrive pas à formuler .
J'ai tenté de faire avec IF en calculant C(colonne)+1- C mais formule trop complexe à mon niveau.
______=> Si=1 alors faire le calcul sur la suivante jusqu'à ce que l'on obtienne résultat>1 alors de cellule de départ jusqu'à cellule juste avant résultat >1 "à"
______=> Si>1 alors "et"
En pièce jointe le code à partir du moment ou j'ai récupéré la valeur des checkbox.
Merci d'avance pour votre aide.

 

[Dranreb]

Bonsoir.
Une Function qui vous le sortirait sans avoir besoin de ventiler dans des colonnes le texte brut :

Function Box(ByVal Don As String) As String
   Dim TJn() As String, P As Byte, N As Byte, TLog(1 To 71) As Boolean, Déb As Integer, Fin As Integer
   TJn = Split(Don, ",")
   For P = 0 To UBound(TJn)
      TLog(TJn(P)) = True
      Next P
   Déb = 72: Fin = 0
   ReDim TJn(1 To 70): P = 0
   For N = 1 To 71
      If TLog(N) Then
         If Déb > N Then Déb = N
         Fin = N
      Else
         Select Case Fin - Déb
            Case Is > 1: P = P + 1: TJn(P) = Déb & " à " & Fin
            Case 1: P = P + 1: TJn(P) = Déb: P = P + 1: TJn(P) = Fin
            Case 0: P = P + 1: TJn(P) = Déb: End Select
         Déb = 72: Fin = 0
         End If
      Next N
   If P > 1 Then P = P - 1: TJn(P) = TJn(P) & " et " & TJn(P + 1)
   ReDim Preserve TJn(1 To P)
   Box = "Box " & Join(TJn, ", ")
   End Function

Peut être utilisé dans du code ou même en formule dans une cellule :
En E3 :

=Box(U3)

Attention, j'ai modifié ce code car 70 pouvait ne pas être pris.
Par ailleurs je trouve plus lisible de séparer le résultat par des virgules sauf " et " pour le dernier.

 

[job75]

Bonsoir bioteau, Bernard,

Une autre fonction VBA avec un tri par la macro bien connue Quick sort :

Function Suite(txt$, sep$)
Dim a, deb$, i%
txt = Replace(txt, " ", "")
a = Split(txt, sep)
If UBound(a) = -1 Then Suite = "": Exit Function
tri a, 0, UBound(a)
deb = "Box " & Val(a(0))
Suite = deb
For i = 1 To UBound(a)
    If Val(a(i)) = Val(a(i - 1)) + 1 Then
        Suite = deb & " à " & Val(a(i))
    Else
        Suite = Suite & " et " & Val(a(i))
        deb = Suite
    End If
Next
End Function

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = Val(a((gauc + droi) \ 2))
g = gauc: d = droi
Do
    Do While Val(a(g)) < ref: g = g + 1: Loop
    Do While ref < Val(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

Formule en E3 du fichier joint =Suite(U3;",")

Bonne nuit.

 

[CISCO]

Bonsoir

Tu peux essayer avec

Sub Texte()

Text = "Box " & Cells(3, 22)

If Cells(3, 22) +1 = Cells(3, 23) Then suite = 1 Else suite = 0

For i = 23 To 38
If suite = 1 Then ajout = " à " Else ajout = " et "
If (Val(Cells(3, i + 1)) > Val(Cells(3, i)) + 1) Then
Text = Text & ajout & Cells(3, i)
suite = 0
Else
If suite = 0 Or Cells(3, i + 1) = "" Then Text = Text & ajout & Cells(3, i)
suite = 1
End If
Next i

Range("E3") = Text
End Sub


A adapter à ta feuille, en déclarant les variables, en remplaçant 38 par le numéro de la dernière colonne...

@ plus

P.S :
1) Je n'avais pas vu les messages de Dranreb et Job75, que je salue donc maintenant au passage.
2) Le "mieux" serait d'insérer ma proposition, en la modifiant, dans ta macro, et sans passer par l'affichage des valeurs intermédiaires sur la feuille. Cf. les propositions de Dranbeb et Job75 qui font cela très bien certainement : Pas de ventilation des données, c'est mieux...

 

[bioteau]

Bonjour Dranreb, Job75 et CISCO,
Merci pour votre réactivité, je test les solutions et vous fais un retour dès que possible.

 

[bioteau]

J'ai appliqué les 3 codes, ils fonctionnent tous, Merci à vous 3.
Je vais simplement faire 1 petite remarque (c'est facile quand on a le résultat), sur le code de Dranreb et CISCO, si j'ai la suite 1,2,4,6,7,8 le résultat obtenu est Box 1 et 2 4 et 6 à 8 et non Box 1 à 2 et 4 et 6 à 8. Par contre pour la lisibilité je prends note de la remarque de Dranreb sur la "," plutôt que le "et" nettement plus clair en lecture.
J'opte donc pour le code de Job75 (c'est quand même un luxe d'avoir le choix), j'essaye de remplacer le "et" par la virgule et motivation supplémentaire pour ce code est le tri Quicksort qui me servira par la suite sur ce projet.


Par contre lorsque je veux inscrire la formule dans ma macro en E3 :
Range("E3").Value = "=Suite(U3;",")" il m'indique une Erreur de compilation. Attendu fin d'instruction avec la virgule entre "" de surligner, je ne comprends pas pourquoi ?

 

[CISCO]

Bonsoir

Chez moi, ça donne

@ plus

 

[Dranreb]

Bonsoir
Ma fonction Box("1,2,4,6,7,8") renvoie en principe "Box 1, 2, 4 et 6 à 8"
Il n'y pas " à " entre seulement deux numéros qui se suivent puisqu'aucun n'est omis.

 

[bioteau]

Bonsoir
Ma fonction Box("1,2,4,6,7,8") renvoie en principe "Box 1, 2, 4 et 6 à 8"
Il n'y pas " à " entre seulement deux numéros qui se suivent puisqu'aucun n'est omis.

Tu as raison Dranreb, désolé.

 

[bioteau]

Bonsoir

Chez moi, ça donne
Regarde la pièce jointe 1102105

@ plus

Exact CISCO, je ne comprends pas. Désolé

 

[bioteau]

Merci à vous tous, les 3 propositions fonctionnent.