Un scripting.dictionary paranormal ?

**richard_sraing** · 20/09/2012, 08h17

Bonjour tout le monde,

Alors voilà, je dispose dans mon application d'un scripting.dictionary possédé.

Je m'explique,

Je crée et initialise mon dictionary comme ceci :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Dim iCoef
Set iCoef = CreateObject("Scripting.dictionary")
For i = 1 To nbCoef
        iCoef.Add .Cells(3, i), i
Next

J'affiche ensuite, afin de vérifier le contenu de mon dictionary le contenu de ce dernier :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Keys = iCoef.Keys
Debug.Print "clé"
'Loop through Keys array
For i = 0 To UBound(Keys)
Debug.Print "Key", i, Keys(i)
Next
 
Dim Items()
 
'Get dictionary Items
Items = iCoef.Items
Debug.Print "Item"
'Loop through Items array
For i = 0 To UBound(Items)
Debug.Print "Item", i, Items(i)
Next

Et j'obtiens bien le résultat :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
clé
Key            0             1,5 
Key            1             1,25 
Key            2             1 
Key            3             2 
Item
Item           0             1 
Item           1             2 
Item           2             3 
Item           3             4

Par contre, lorsque je tente d'afficher le résultat directement en passant par un index, je n'ai rien :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

Debug.Print "iCoef(2)", iCoef("2")

Et j'ai beau essayer toutes les variantes qui me sont venues à l'esprit :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Debug.Print "iCoef(2)", iCoef(2)
Debug.Print "iCoef(2)", iCoef.Item("2")
Debug.Print "iCoef(2)", iCoef.Item(2)

Je n'obtiens rien du tout.

Quelqu'un pourrait-il me dire ce que je ne comprend pas ?

Je souhaite en fait utiliser mon dictionary dans la portion de code suivante :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

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
For cptouvrier = 4 To nbligne
    For cptcolonne = 6 To nbcolonne
        ' Nous sommes un samedi ou dimanche
        If IsEmpty(.Cells(3, cptcolonne).Value) Then
            ' Nous sommes samedi
            If Left(.Cells(2, cptcolonne).Value, 4) = "same" Then
                coefficient = dCoef.Item("samedi")
                nbreHeures = .Cells(cptouvrier, cptcolonne).Value * coefficient
                heures(cptouvrier - 4, iCoef.Item(CStr(coefficient))) = nbreHeures
            ' Nous sommes dimanche
            ElseIf Left(.Cells(2, cptcolonne).Value, 4) = "dima" Then
                coefficient = dCoef.Item("dimanche")
                nbreHeures = .Cells(cptouvrier, cptcolonne).Value * coefficient
                heures(cptouvrier - 4, iCoef.Item(CStr(coefficient))) = nbreHeures
            End If
        ' Nous sommes un jour férié
        ElseIf .Cells(3, cptcolonne).Value = "férié" Then
            coefficient = dCoef.Item("férié")
            nbreHeures = .Cells(cptouvrier, cptcolonne).Value * coefficient
            heures(cptouvrier - 4, iCoef.Item(CStr(coefficient))) = nbreHeures
        'Nous sommes un jour normal
        Else
            coefficient = dCoef.Item(.Cells(3, cptcolonne))
            nbreHeures = .Cells(cptouvrier, cptcolonne).Value * coefficient
            heures(cptouvrier - 4, iCoef.Item(CStr(coefficient))) = nbreHeures
        End If
    Next
    ' il faut écrire le résultat dans les cellules de début
    For i = 1 To nbCoef
        .Cells(cptouvrier, i).Value = heures(cptouvrier - 4, i)
    Next
Next

Pour plus de faciliter, je vous joint le fichier xls en question.
Petite explications :
La macro en question se trouve dans le Module1 et porte le nom "Calcul_Heure"
Il faudra par la suite, que je lie la macro au fait de pousser sur le bouton Calcul se trouvant dans chaque feuille <Mois> <Année>.
Pour lancer la macro, placer vous dans une feuille de calcul de ce type, (novembre par exemple).

Pour toutes informations complémentaires, n'hésitez pas à me bombarder de question, je tâcherai d'y répondre le plus rapidement possible.

En vous remerciant pour toutes l'aide qu'il vous sera possible de me fournir, je vous souhaite à tous de passer une superbe journée.

**issoram** · 20/09/2012, 09h21

Bonjour,

J'ai testé un bout de ton code chez moi en l'adaptant un peu et ça marche.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 With Worksheets("Novembre 2012")
 
        Set iCoef = CreateObject("Scripting.dictionary")
        For i = 1 To 4
            iCoef.Add .Cells(3, i).Value, i
        Next
 
  End With
 
        keys = iCoef.keys
        Debug.Print "clé"
        ''Loop through Keys array
        For i = 0 To UBound(keys)
            Debug.Print "Key", i, keys(i), iCoef(keys(i))
        Next
 
        Dim Items
        ''Get dictionary Items
        Items = iCoef.Items
        Debug.Print "Item"
        ''Loop through Items array
        For i = 0 To UBound(Items)
        Debug.Print "Item", i, Items(i)
        Next
 
        Debug.Print "iCoef(2)", iCoef(2)   'pas de guillemets ici et ça passe => donne 4
 
End Sub

Cordialement.

**richard_sraing** · 20/09/2012, 11h07

Oh my god.

Je viens de voir que je n'avais pas vraiment la tête à cela les derniers jours.

J'ai trouvé le pourquoi du comment.

Voici la macro Calcul_Heure() qui semble fonctionner, à priori du moins.

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

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
89
90
91
92
93
94
95
96
97
98
99
100
101
Public Sub Calcul_Heure() '(mois As String)
    'MsgBox "Nom de la feuille: " & mois
    Dim dCoef, heures(), indexOuvriers, iCoef, nbCoef, tCoef
    Set dCoef = Nothing
    Set dCoef = CreateObject("Scripting.dictionary")
    Set tCoef = CreateObject("Scripting.dictionary")
    Set indexOuvriers = CreateObject("Scripting.dictionary")
 
    With Worksheets("config")
        nbligne = .Range("B2:B" & .Range("B" & .Rows.count).End(xlUp).Row).count
 
        For Each c In .Range("A2:A" & .Range("A" & .Rows.count).End(xlUp).Row)
            If Not dCoef.Exists(c.Value) Then dCoef.Add c.Value, c.Offset(0, 1).Value
        Next c
 
        For Each c In .Range("B2:B" & .Range("B" & .Rows.count).End(xlUp).Row)
            If Not tCoef.Exists(c.Value) Then tCoef.Add c.Value, c.Offset(0, -1).Value
        Next c
        nbCoef = tCoef.count
        'Set tCoef = Nothing
 
    End With
 
 
    With Worksheets("ouvriers")
        nbligne = .Range("A2:A" & .Range("A" & .Rows.count).End(xlUp).Row).count
        ReDim heures(nbligne, 4)
        For i = 1 To nbligne
            heures(i - 1, 0) = .Cells(i + 1, 1)
            heures(i - 1, 1) = 0
            heures(i - 1, 2) = 0
            heures(i - 1, 3) = 0
            heures(i - 1, 4) = 0
        Next
    End With
 
    With Worksheets(ActiveSheet.Name)
        Set iCoef = CreateObject("Scripting.dictionary")
        For i = 1 To nbCoef
            iCoef.Add .Cells(3, i).Value, i
        Next
        keys = iCoef.keys
        Debug.Print "clé"
        ''Loop through Keys array
        For i = 0 To UBound(keys)
        Debug.Print "Key", i, keys(i)
        Next
 
        Dim Items()
 
        ''Get dictionary Items
        Items = iCoef.Items
        Debug.Print "Item"
        ''Loop through Items array
        For i = 0 To UBound(Items)
        Debug.Print "Item", i, Items(i)
        Next
 
        nbligne = .Range("E4:E" & .Range("E" & .Rows.count).End(xlUp).Row).count
        For i = 4 To nbligne
            indexOuvriers.Add .Cells(i, 5), i
        Next
 
        nbligne = .Range("E1:E" & .Range("E" & .Rows.count).End(xlUp).Row).count
        nbcolonne = .Range("F3").SpecialCells(xlCellTypeLastCell).Column
        Dim nbreHeures As Date
        For cptouvrier = 4 To nbligne
            For cptcolonne = 6 To nbcolonne
                ' Nous sommes un samedi ou dimanche
                If IsEmpty(.Cells(3, cptcolonne).Value) Then
                    ' Nous sommes samedi
                    If Left(.Cells(2, cptcolonne).Value, 4) = "same" Then
                        coefficient = dCoef("samedi")
                        nbreHeures = .Cells(cptouvrier, cptcolonne).Value * coefficient
                        heures(cptouvrier - 4, iCoef(coefficient)) = heures(cptouvrier - 4, iCoef(coefficient)) + nbreHeures
                    ' Nous sommes dimanche
                    ElseIf Left(.Cells(2, cptcolonne).Value, 4) = "dima" Then
                        coefficient = dCoef("dimanche")
                        nbreHeures = .Cells(cptouvrier, cptcolonne).Value * coefficient
                        heures(cptouvrier - 4, iCoef(coefficient)) = heures(cptouvrier - 4, iCoef(coefficient)) + nbreHeures
                    End If
                ' Nous sommes un jour férié
                ElseIf .Cells(3, cptcolonne).Value = "férié" Then
                    coefficient = dCoef("férié")
                    nbreHeures = .Cells(cptouvrier, cptcolonne).Value * coefficient
                    heures(cptouvrier - 4, iCoef(coefficient)) = heures(cptouvrier - 4, iCoef(coefficient)) + nbreHeures
                'Nous sommes un jour normal
                Else
                    coefficient = dCoef(CStr(.Cells(3, cptcolonne))) ' fallait spécifier sous forme de chaine car la Key est une chaine de caractère
                    nbreHeures = .Cells(cptouvrier, cptcolonne).Value * coefficient
                    heures(cptouvrier - 4, iCoef(coefficient)) = heures(cptouvrier - 4, iCoef(coefficient)) + nbreHeures
                End If
            Next
            ' il faut écrire le résultat dans les cellules de début
            For i = 1 To nbCoef
                .Cells(cptouvrier, i).Value = heures(cptouvrier - 4, i)
            Next
        Next
 
    End With
End Sub

Bon maintenant que cela est fait, il ne me reste plus qu'à trouver comment assigner une fonction /macro à un bouton créé dynamiquement dans chaque feuille de calcul.

Un scripting.dictionary paranormal ? [XL-2007]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager