VBA字典对象(作为属性)返回错误的对象

时间:2020-11-03 16:30:44

标签: vba dictionary properties attributes

我已经实现了以下详细的类结构,以比较两个物料清单。 我设法将类的对象放入相应的字典中。 请让我知道我错过了哪些重要细节...

类/对象结构(与我同在):

clsBom 类的对象包含:

  • 字典 mVariants ,每个包含:
      clsVariant
    • 个对象,每个对象包含:
      • 词典 mVariantLines_Compressed ,其中每个包含:
          clsVariantLine
        • 个对象,每个对象都包含数量,MPN,MFR,RefDez 和由RefDez键控的属性-从组件的参考指示符起

All looks Good...

clsBom:

Private mVariantNames As Collection
Private mVariants As Scripting.Dictionary

Public Property Get VariantNames() As Collection
    Set VariantNames = mVariantNames
End Property
Public Sub Add_Variant_Name(VarName As String)
    mVariantNames.Add VarName
    mNumber_Of_Variants = mNumber_Of_Variants + 1
End Sub

Public Property Get Variants() As Scripting.Dictionary
    Set Variants = mVariants
End Property
Public Sub Add_Variant(Var As Object)
    mVariants.Add Var.VariantName, Var
End Sub

这是我填写clsVariant对象并将其添加到clsBOM对象内的mVariant中的方式:

Dim VarName As Variant
Dim Var As clsVariant
For Each VarName In VariantNames
    Set Var = New clsVariant
    Call Var.Absorb_Data(Me.WBook.Worksheets(VarName))
    Call Me.Add_Variant(Var)
    'Set Var = Nothing
Next

clsVariant:

Private mVariantLines_Compressed As Scripting.Dictionary
Private mVariantName As String

Public Property Get VariantName() As String
    VariantName = mVariantName
End Property
Public Property Let VariantName(tVariantName As String)
    mVariantName = tVariantName
End Property

Public Property Get VariantLines_Compressed() As Scripting.Dictionary
    Set VariantLines_Compressed = mVariantLines_Compressed
End Property

Public Sub Add_Variant_Line(tVarLine As Object)
    mVariantLines_Compressed.Add tVarLine.RefDez, tVarLine
End Sub

Public Sub Absorb_Data(tSht As Worksheet)
...
  various attributes within the object get assigned
...
    Dim mDataRow As Range
    For Each mDataRow In mDataRange.Rows
        If mDataRow.Cells(1).Value <> vbNullString And IsNumeric(mDataRow.Cells(1)) Then    ' Blank Lines and Programmed Components Line rejected
            Dim VarLine As New clsVariantLine
            Call VarLine.Init(mHeader)
            Call VarLine.Import_Data(mDataRow)
            Call Add_Variant_Line(VarLine)
            'If mDataRow.Cells(6).Value = "ZD4" Then Stop
        End If
        'If mDataRow.Row = 214 Then Stop
    Next
End Sub

clsVariantLine:

Private mQty As Integer
Private mMFR As String
Private mMPN As String
Private mRefDez As String
...

Public Property Get Qty() As Integer
    Qty = mQty
End Property
Public Property Let Qty(tQty As Integer)
    mQty = tQty
End Property
Public Property Get MFR() As String
    MFR = mMFR
End Property
Public Property Let MFR(tMFR As String)
    mMFR = tMFR
End Property
Public Property Get MPN() As String
    MPN = mMPN
End Property
Public Property Let MPN(tMPN As String)
    mMPN = tMPN
End Property
Public Property Get RefDez() As String
    RefDez = mRefDez
End Property
Public Property Let RefDez(tRefDez As String)
    mRefDez = tRefDez
End Property
...

问题描述:

我无法正确地从词典中调出保存的对象。 通过使用 For Each 循环,无论我使用什么Dict键,我都只会得到添加到 mVariantLines_Compressed clsVariantLine 的最后一个对象的属性。

通过For Each Var In LBom.Variants.Keys Var 被正确分配给字典键的每一项,但是更进一步,For Each Var_Line In LBom_Variant.VariantLines_Compressed.Keys无法提供对LBom_Line中对象的访问和RBom_Line及其属性Qty,MPN,MFR,RefDez。

每次迭代时,我只会获得LBom_Variant.VariantLines_Compressed RBom_Variant.VariantLines_Compressed 中最后一个对象的属性。

这是我使用以上所有功能的模块,并且问题描述适用:

Dim LBom As clsBom   ' Local BOM  - as of the first one tied in
Dim RBom As clsBom   ' Remote BOM - second BOM
Set LBom = New clsBom
Set RBom = New clsBom

Dim Var As Variant
Dim LBom_Variant As Variant
Dim RBom_Variant As Variant

Dim Var_Line As Variant
Dim LBom_Line As Variant
Dim RBom_Line As Variant

For Each Var In LBom.Variants.Keys
        
    ' Variant Comparison
    If RBom.Variants.Exists(Var) = True Then
        
        ' Variant found

        Set LBom_Variant = LBom.Variants(Var)
        Set RBom_Variant = RBom.Variants(Var)
        
        Stop
        
        For Each Var_Line In LBom_Variant.VariantLines_Compressed.Keys
            
            ' Component Line Comparison
            If RBom_Variant.VariantLines_Compressed.Exists(Var_Line) = True Then
                
                ' REFDEZ found

                Set LBom_Line = LBom_Variant.VariantLines_Compressed(Var_Line)
                Set RBom_Line = RBom_Variant.VariantLines_Compressed(Var_Line)
                
                Stop
                
                ' Component Detail Comparison
                MsgBox (LBom_Line.Qty & LBom_Line.MFR & LBom_Line.MPN & LBom_Line.RefDez)
                MsgBox (RBom_Line.Qty & RBom_Line.MFR & RBom_Line.MPN & RBom_Line.RefDez)
                    
                Stop
                    
                ' If Component Line Difference found - then Component Line has to be kept
                ' otherwise it can be removed

            Else
                ' REFDEZ not found
            End If
        Next
    Else
        ' Variant not found
    End If
    
Next

0 个答案:

没有答案