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.
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.