1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88
|
Function geser(incr As Integer, ParamArray x() As Variant) As String
Dim bouc1, bouc2 As Variant
Dim bouc3 As Integer
Dim mamat As Variant
Dim nb As Long
Dim tempo As Variant
Dim collresu As New Collection
Dim chres As String
'comptage des données
For Each bouc1 In x
If IsArray(bouc1) Then
For Each bouc2 In bouc1
nb = nb + 1
Next bouc2
Else
nb = nb + 1
End If
Next bouc1
'on remplit le vecteur résultat
ReDim mamat(1 To nb, 1 To 2)
nb = 0
For Each bouc1 In x
If IsArray(bouc1) Then
For Each bouc2 In bouc1
nb = nb + 1
mamat(nb, 1) = bouc2
Next bouc2
Else
nb = nb + 1
mamat(nb, 1) = bouc1
End If
Next bouc1
'on trie le vecteur
For bouc1 = 1 To nb
For bouc2 = bouc1 + 1 To nb
If mamat(bouc1, 1) > mamat(bouc2, 1) Then
tempo = mamat(bouc1, 1)
mamat(bouc1, 1) = mamat(bouc2, 1)
mamat(bouc2, 1) = tempo
End If
Next bouc2
Next bouc1
'attribution résultat
For bouc1 = nb - 1 To 1 Step -1
If mamat(bouc1, 1) - mamat(bouc1 + 1, 1) = -incr Then
If mamat(bouc1 + 1, 2) = 0 Then
mamat(bouc1, 2) = 2
mamat(bouc1 + 1, 2) = 1
Else
mamat(bouc1, 2) = mamat(bouc1 + 1, 2) + 1
End If
Else
mamat(bouc1, 2) = 0
End If
Next bouc1
'gestion resultat
For bouc1 = 1 To nb
chres = "coucou"
If mamat(bouc1, 2) <> 0 Then
On Error Resume Next
chres = collresu(Format(mamat(bouc1, 2), "0000"))
If Err.Number = 5 Then
collresu.Add key:=Format(mamat(bouc1, 2), "0000"), Item:=Format(mamat(bouc1, 2), "0000") & "/" & mamat(bouc1, 1)
Err.Clear
Else
collresu.Remove (Format(mamat(bouc1, 2), "0000"))
collresu.Add key:=Format(mamat(bouc1, 2), "0000"), Item:=chres & "/" & mamat(bouc1, 1)
End If
bouc1 = bouc1 + mamat(bouc1, 2) - 1
End If
Next bouc1
For Each bouc1 In collresu
chres = (Len(bouc1) - Len(Replace(bouc1, "/", ""))) & " série de " & Val(bouc1) & Chr(10)
mamat = Split(Right(bouc1, Len(bouc1) - 4), "/")
For bouc2 = 0 To UBound(mamat)
For bouc3 = 1 To Val(bouc1)
chres = chres & (((bouc3 - 1) * incr) + mamat(bouc2)) & ";"
Next bouc3
chres = chres & Chr(10)
Next bouc2
MsgBox (chres)
Next bouc1
End Function |
Partager