我已经实现了以下详细的类结构,以比较两个物料清单。 我设法将类的对象放入相应的字典中。 请让我知道我错过了哪些重要细节...
类/对象结构(与我同在):
clsBom 类的对象包含:
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