Compactage d'une série numérique

Commenter

Contenu du snippet

Il s'agit de 2 petites fonctions très simples, permettant de "compacter" une suite d'entiers, ou plus exactement de l'écrire sous une forme plus dense. Exemple:
1,2,3,4,6,9,10,11 ==> 1:4,6,9:11
La fonction décompacte fait le travail inverse (1:3,5 -> 1,2,3,5)

Rien de bien extraordinaire, mais à ajouter pourquoi pas à une librairie de fonctions de manipulation de texte.

Source / Exemple : 


Option Explicit

'---------------------------------------------------------------------------------------
' Procedure : Compacte
' DateTime  : 24/07/2006 20:29
' Author    : Jean-Marc
' Purpose   : Compacte une "collection" de valeurs déja triées en
'             ordre croissant.
' Exemple   : 1,2,3,4,6,9,10,11 ==> 1:4,6,9:11
'
'---------------------------------------------------------------------------------------
'
Public Function Compacte(ByVal cdata As Collection) As String
Dim idx As Long             ' parcours de la collection
Dim vidx As Long            ' valeur (possible) du premier element d'une suite
Dim vc As Long              ' valeur courante
Dim vp As Long              ' valeur precedente
Dim suite As Boolean        ' flag indiquant si l'état courant est dans une suite ou non
Dim tmpResult As String     ' construction du résultat final par concaténations successives

    If cdata.Count = 0 Then     ' si il n'y a pas d'éléments, quitte et retourne une chaine vide
        Exit Function
    End If
    vidx = cdata.Item(1)        ' initialisations, avec le premier élément
    vp = vidx
    For idx = 2 To cdata.Count  ' parcours à partir du second
        vc = cdata.Item(idx)    ' récupération de la valeur courante
        If (vp + 1) = vc Then   ' si elle suit immédiatement la valeur précédente
            suite = True        ' on est dans une suite
        Else
            If suite Then       ' sinon, on regarde si on était dans une suite
                                ' si oui, on concatene la suite, qui part de vidx jusqu'à vp
                tmpResult = tmpResult & "," & CStr(vidx) & ":" & CStr(vp)
            Else                ' si non, on concatene la valeur précédente
                tmpResult = tmpResult & "," & CStr(vp)
            End If
            vidx = vc           ' on réinitialise le premier élément d'une suite potentielle
            suite = False       ' et on reset le flag de suite
        End If
        vp = vc                 ' stockage de la valeur courante dans vp
    Next idx
    If suite Then               ' traitement final, identique à celui qui est dans la boucle
        tmpResult = tmpResult & "," & CStr(vidx) & ":" & CStr(vp)
    Else
        tmpResult = tmpResult & "," & CStr(vp)
    End If
    Compacte = Mid$(tmpResult, 2)   ' élimination de la première virgule
End Function

'---------------------------------------------------------------------------------------
' Procedure : Decompacte
' DateTime  : 25/07/2006 20:15
' Author    : Jean-Marc
' Purpose   : Decompacte une chaine produite par compacte
' Exemple   : 1:4,6,9:11 ==> 1,2,3,4,6,9,10,11
'
'---------------------------------------------------------------------------------------
'
Public Function Decompacte(ByVal data As String) As String
Dim t() As String       ' split la chaine
Dim i As Long           ' parcours des éléments de la chaine
Dim j As Long           ' génération des suites
Dim p As Long           ' cherche les suites grace au signe :
Dim tmpResult As String ' résultat intermédiaire, construite par concatenation

    If data = vbNullString Then ' si chaine vide, retourne vide
        Exit Function
    End If

    t = Split(data, ",")                ' split avec les virgules
    For i = LBound(t()) To UBound(t())  ' parcours
        p = InStr(t(i), ":")
        If p <> 0 Then                  ' est ce une suite (a:b)
            ' si oui, parcours de 'a' à 'b'
            For j = Val(Mid$(t(i), 1, p - 1)) To Val(Mid$(t(i), p + 1))
                tmpResult = tmpResult & "," & CStr(j)
            Next j
        Else
            tmpResult = tmpResult & "," & CStr(t(i))    ' sinon ajoute juste l'élément
        End If
    Next i
    Decompacte = Mid$(tmpResult, 2) ' retourne le resultat, en éliminant la première virgule

End Function

'
' exemple de compactage
'
Private Sub Command1_Click()
Dim cc As Collection
Dim result As String
    
    Set cc = New Collection
    cc.Add (1): cc.Add (2): cc.Add (3): cc.Add (4): cc.Add (6): cc.Add (9): cc.Add (10): cc.Add (11)
    result = Compacte(cc)
    Debug.Print result;: If result = "1:4,6,9:11" Then Debug.Print "   ==> OK" Else Debug.Print "   ==> KO"
End Sub

'
' exemple décompactage
'
Private Sub Command2_Click()
Dim s As String
Dim r As String

    s = "2:5,6,7,9:13,15:17,19,20"
    r = Decompacte(s)
    Debug.Print s & " => " & r
End Sub

Conclusion :


Note: la fonction compactage prend une collection en argument d'entrée, on peut très simplement la modifier ou la décliner en différentes versions: avec un tableau, une chaine de caractère, etc.

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (jean_marc_n2)