J'essaie d'écrire du code qui regarde un tableau "arr", puis parcourt chaque valeur de ce tableau pour le comparer à un dictionnaire nouvellement créé. Si la clé existe déjà, la valeur (nombre) de la clé est supposée être incrémentée de 1, sinon la clé doit être ajoutée avec une valeur de 1.

Cependant, la ligne ci-dessous lance une erreur Object Required:

        If dic.Exists(c.Value) Then ' Runtime Error 424: Object Required

Le sous-marin entier est ci-dessous:

Private Sub PODic()


    Dim arr As Variant
    Dim Counter As Long
    Dim dic As Object
    Dim lrow As Long
    Dim c As Variant


    Set dic = CreateObject("Scripting.Dictionary") ' late bind
        dic.CompareMode = vbTextCompare

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With


    lrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 4).End(xlUp).row
    lrow = lrow - 1
        Debug.Print lrow

    arr = ActiveSheet.Range("d2", ActiveSheet.Cells(lrow, "d")).Value

        For Each c In arr
            Debug.Print c
            If dic.Exists(c.Value) Then ' Runtime Error 424: Object Required
                dic(c.Value) = dic(c.Value) + 1
            Else
                dic.Add c.Value, 1
            End If
        Next

    For Each k In dic
        Debug.Print k & "," & dic(k)
    Next k



    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With

    MsgBox "Populate dictionary macro complete."



End Sub

Je pense que cela pourrait être lié au type de variable utilisé pour c (ou pour le dic peut-être) mais je ne peux pas comprendre où le problème se produit. J'ai également essayé de résoudre ce problème en créant un On Error GoTo mais j'ai eu le même problème.

         On Error GoTo ERRINCVAL
            dic.Add cell.Value, 1
            On Error GoTo 0



ERRINCVAL:

    dic(c.Value) = dic(c.Value) + 1 ' Same error thrown on this line, if I try to use GoTo instead of If
    Resume Next

Aide très appréciée.

0
LachyS 30 déc. 2017 à 08:13

6 réponses

Meilleure réponse

c.value n'a pas de sens ici. c voici un item dans le array afin que vous puissiez vous y référer directement.

Vous devriez l'essayer comme ça ...

For Each c In arr
    Debug.Print c
    If dic.Exists(c) Then
        dic(c) = dic(c) + 1
    Else
        dic.Add c, 1
    End If
Next

Ou vous pouvez également utiliser l'approche suivante pour obtenir le résultat souhaité ...

Dim i As Long
arr = ActiveSheet.Range("d2", ActiveSheet.Cells(lrow, "d")).Value

For i = 1 To UBound(arr, 1)
    Debug.Print arr(i, 1)
    If dic.Exists(arr(i, 1)) Then ' Runtime Error 424: Object Required
        dic(arr(i, 1)) = dic(arr(i, 1)) + 1
    Else
        dic.Add arr(i, 1), 1
    End If
Next
0
Subodh Tiwari sktneer 30 déc. 2017 à 06:56

@sktneer a la bonne réponse. Je voulais juste montrer une manière plus propre de l'écrire.

L'utilisation d'une instruction Avec rend le code plus lisible et plus efficace.

Il n'y a aucune raison d'avoir une variable Dernière ligne .

Plage ("D2", Cellules (Rows.Count, "D"). End (xlUp)). Valeur

Il n'est pas nécessaire d'utiliser une variable de tableau temporaire pour une utilisation dans une boucle For Each . Le VBA en créera automatiquement un lorsqu'il initialisera la boucle.

Pour chaque clé d'entrée .Range ("D2", .Cells (.Rows.Count, "D"). End (xlUp)). Valeur

Il n'est pas nécessaire de tester si une clé existe, puis d'ajouter la clé avec la valeur 1 ou d'incrémenter la clé existante. Le VBA créera automatiquement la clé s'il n'existe pas.

dic (clé) = dic (clé) + 1

Réutilisez la même variable Clé lors de l'ajout de paires Clé / Valeur ou lors d'une itération dans le Dictionnaire .

dic.Add Clé, 1

Pour chaque clé en dic

Vous pouvez utiliser Rejoindre pour imprimer toutes les clés et les éléments dans la fenêtre immédiate.

Debug.Print "Clés:"; Rejoindre (dic.Keys (), ",")

Debug.Print "Éléments:"; Join (dic.Items (), ",")

Private Sub PODic()

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    Dim dic As Object, Key As Variant

    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = vbTextCompare

    With ActiveSheet
        For Each Key In .Range("D2", .Cells(.Rows.Count, "D").End(xlUp)).Value
            dic(Key) = dic(Key) + 1
        Next
    End With

    Debug.Print "Keys: "; Join(dic.Keys(), ",")
    Debug.Print "Items: "; Join(dic.Items(), ",")

    For Each Key In dic
        Debug.Print Key & "," & dic(Key)
    Next

    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With

    MsgBox "Populate dictionary macro complete."

End Sub
3
user6432984user6432984 30 déc. 2017 à 10:48

Vous devez déclarer l'objet dictionnaire.

Nous déclarons un dictionnaire comme suit :

Dim dict As New Scripting.Dictionary

ou

Dim dict As Scripting.Dictionary
Set dict = New Scripting.Dictionary

Beaucoup plus d'informations sur la configuration et l'utilisation des dictionnaires dans VBA sur ce site.


En règle générale également, utilisez Option Explicit en haut de chaque module (en particulier lors du dépannage) pour vous assurer que vos variables et objets sont tous correctement configurés.

2
ashleedawg 30 déc. 2017 à 05:49

L'utilisation de c.value implique que vous le traitez comme un objet range et que vous accédez à sa propriété 'value' - ce que votre code vous laissera faire car c est déclaré comme variant.

Cependant, je pense que vous faites une boucle sur chaque élément du tableau - auquel cas vous ne devriez pas utiliser c.value, juste c seul.

Je pense qu'il serait préférable de parcourir le tableau en utilisant une boucle for-next entre ubound et lbound du tableau.

Alors essayez:

    Dim Index as Long

    For Index = lbound(arr,1) to ubound(arr,1)

If dic.Exists(arr(Index,1)) Then

' Array arr is 1-based but items in dic might be 0-based, so adjust if necessary'

dic(arr(Index-1,1)) = dic(arr(Index-1,1)) + 1
' if dic is not 0-based, get rid of the -1 above.'

Else

dic.Add arr(Index,1), 1

End If

    Next index

Non testé, écrit sur mobile.

-1
chillin 30 déc. 2017 à 05:36

Le code final s'est terminé:

Sous PODic privé ()

Dim arr As Variant
Dim Counter As Long

Dim lrow As Long
Dim c As Variant

Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary") ' late bind
    dic.CompareMode = vbTextCompare

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With


lrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 4).End(xlUp).row
lrow = lrow
    Debug.Print lrow

Dim i As Long
    arr = ActiveSheet.Range("d2", ActiveSheet.Cells(lrow, "d")).Value

For i = 1 To UBound(arr, 1)
    Debug.Print arr(i, 1)
    If dic.Exists(arr(i, 1)) Then
        dic(arr(i, 1)) = dic(arr(i, 1)) + 1
    Else
        dic.Add arr(i, 1), 1
    End If
Next

For Each k In dic
    Debug.Print k & "," & dic(k)
Next k
Debug.Print dic.Count


With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

0
LachyS 30 déc. 2017 à 06:43

Vous pouvez utiliser une forme simplifiée d'attribution de valeur au dictionnaire:

dic("key1") = dic("key1") + 1
1
JohnyL 30 déc. 2017 à 10:28