Remplir un tableau à partir d'un dictionnaire

Nico1984 -  
Mytå Messages postés 4246 Date d'inscription   Statut Contributeur Dernière intervention   -
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

  1. Mytå Messages postés 4246 Date d'inscription   Statut Contributeur Dernière intervention   958
     
    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