Remplir un tableau à partir d'un dictionnaire

Fermé
Nico1984 - 10 nov. 2012 à 19:52
Mytå Messages postés 2973 Date d'inscription mardi 20 janvier 2009 Statut Contributeur Dernière intervention 20 décembre 2016 - 10 nov. 2012 à 22:42
Bonjour a tous,

Merci à tous ceux qui prennent le temps de répondre car ce forum ça m'a très souvent aidé ! Aujourd'hui c'est à mon tour de poster car je ne vois plus du tout comment m'en sortir pour résoudre mon problème. Je suis débutant en VBA.

Voici la macro que je veux réaliser :
c'est une feuille qui permet de calculer des dates par ex si on doit faire une action répéter tous les 2 jours et ce 3 fois. Cela nous donnera :
ex J0 -> 10/11/12
J2 -> 12/11/12
J4 -> 14/11/12
J6 -> 16/11/12

Mon problème concerne l'affichage des résultats, car cette macro me donne les objets sur la ligne 19 et les clés sur la ligne 20. Si il y a peu de point ce n'est pas géant mais il y a 100 points par ex ça devient illisible. Du coup j'aimerais qu'il m'affiche le résultat sous forme d'un tableau avec par ex les 5 premiers points sur les lignes 19 et 20 les 5 suivants sur 21 et 22 etc.

En vous remerciant par avance,
Cordialement,
Nico

Voici mon code :
Sub testdico()

Dim dico As Variant
Dim d As Variant

Set dico = CreateObject("Scripting.Dictionary")


dateJ0 = Range("C16").Value
jours = Range("E16").Value
Points = Range("I16").Value 'Nombre de répétitions

For m = 0 To Points

If jours = Empty Then
MsgBox "Remplir le nombre de jours"
End
Else
dico.Add (dateJ0 + (m * jours)), ("J " & (jours) * m)
End If
Next m



x = 1
For Each e In dico.items
Range("B19").Select
ActiveCell.Offset(0, x) = e
ActiveCell.Offset(0, x).Select
ActiveCell.Interior.ColorIndex = 48
x = x + 1
Next e

x = 1
For Each e In dico.keys
Range("B20").Select
ActiveCell.Offset(0, x) = e
x = x + 1
Next e

End Sub


1 réponse

Mytå Messages postés 2973 Date d'inscription mardi 20 janvier 2009 Statut Contributeur Dernière intervention 20 décembre 2016 942
10 nov. 2012 à 22:42
Salut le forum

Le code suivant répond à ta demande

Sub testdico()
Dim dico As Object
Dim Date_J0 As Date
Dim Jours As Integer
Dim points As Integer
Dim m As Integer
Dim Dico_keys
Dim Dico_Items
Dim LigOffset As Byte
Dim ColOffset As Byte
Dim n As Integer

    Set dico = CreateObject("Scripting.Dictionary")

    Date_J0 = Range("C16").Value
    Jours = Range("E16").Value
    points = Range("I16").Value    'Nombre de répétitions

    For m = 0 To points
        If Jours = Empty Then
            MsgBox "Remplir le nombre de jours"
            End
        Else
            dico.Add (Date_J0 + (m * Jours)), ("J " & (Jours) * m)
        End If
    Next m


    Dico_keys = dico.keys
    Dico_Items = dico.items
    LigOffset = 0
    ColOffset = 0
    
    For n = 0 To dico.Count - 1
        With Range("C19")
            .Offset(LigOffset, ColOffset) = Dico_keys(n)
            .Offset(LigOffset, ColOffset).Interior.ColorIndex = 48
            .Offset(LigOffset + 1, ColOffset) = Dico_Items(n)
        End With
        ColOffset = ColOffset + 1
        If ColOffset > 4 Then
            LigOffset = LigOffset + 2
            ColOffset = 0
        End If
    Next n

End Sub

Mytå
0