BOM表查询的VB实现方法

相关需求及信息请点击这里查看。



用VB代码实现方法

引用：无，部件：无

设计：在Form1中右下角加入一个CommandButton，名称默认为Command1，窗体的AutoRedraw属性设为True





窗体文件一：Form1



Option Explicit



Private mBom As Collection              @#这是入口的集合
Private mBomReturn As Collection        @#这是出口的集合，未经处理
Private mBomReturnLast As Collection    @#这是出口的集合，经过处理




Private Sub AddBomRecord()
@#在这里往mBom加入数据库里面的原内容，为求简便，我不想连接数据库
@#直接往里面写入记录了，如果需要，你就直接连接数据库，分析一下里面的
@#代码，然后再往mBom里面写入记录
@#FG      SA1     2.0000
@#FG      SA2     3.0000
@#SA1     PT1     4.0000
@#SA1     PT2     5.0000
@#SA2     PT1     6.0000
@#SA2     PT3     7.0000

Dim mBomValue As cBomValue

Set mBomValue = New cBomValue

mBomValue.AssBom = "FG"
mBomValue.BomPoint = "SA1"
mBomValue.Quantity = 2

mBom.Add mBomValue

Set mBomValue = New cBomValue

mBomValue.AssBom = "FG"
mBomValue.BomPoint = "SA2"
mBomValue.Quantity = 3

mBom.Add mBomValue

Set mBomValue = New cBomValue

mBomValue.AssBom = "SA1"
mBomValue.BomPoint = "PT1"
mBomValue.Quantity = 4

mBom.Add mBomValue

Set mBomValue = New cBomValue

mBomValue.AssBom = "SA1"
mBomValue.BomPoint = "PT2"
mBomValue.Quantity = 5

mBom.Add mBomValue

Set mBomValue = New cBomValue

mBomValue.AssBom = "SA2"
mBomValue.BomPoint = "PT1"
mBomValue.Quantity = 6

mBom.Add mBomValue

Set mBomValue = New cBomValue

mBomValue.AssBom = "SA2"
mBomValue.BomPoint = "PT3"
mBomValue.Quantity = 7

mBom.Add mBomValue



End Sub

Private Sub Command1_Click()

Dim i As Integer
Dim m As cBomValue

@#进行计算

@#注意以下两个新建实例，必须放置于GetBomList前，该操作也有清空现有数据的作用，否则会造成错误
@#即第一次运行后保存了数据于该两个变量中，并未清除相关记录，而下一次运行则在现有的基础上再进行加操作，因此数据错误了。

Set mBomReturn = New Collection
Set mBomReturnLast = New Collection

Call GetBomList

@#计算后，mBomReturnLast返回的就是最终结果
If mBomReturnLast.Count < 0 Then
    MsgBox "没有记录！", vbInformation + vbOKOnly, "BOM表计算"
    Exit Sub
Else

    @#在窗体中打印出列表的内容
    Me.Cls
   
    Print "Assbom" & vbTab & "Point" & vbTab & "Quantity"
   
    For i = 1 To mBomReturnLast.Count
        Set m = mBomReturnLast.Item(i)
       
        Print m.AssBom & vbTab & m.BomPoint & vbTab & m.Quantity
    Next i
End If


End Sub

Private Sub Form_Load()

@#窗体调用处新建实例，然后再装入数据

Set mBom = New Collection

AddBomRecord

End Sub



@#***************************************************************
@#*
@#*  以下为进行计算部分的代码，注意Collection里面的处理
@#*
@#***************************************************************


Private Sub GetBomList()
    Dim mBomTop As Collection       @#这里保存了顶级产成品
    Dim i As Integer
    Dim j As Integer
    Dim m As cBomReturnValue
    Dim mLast As cBomValue
    Dim bFind As Boolean
   
   
   
    Set mBomTop = New Collection
   
   
    @#装入顶级产成品
   
    LoadBomTop mBomTop
   
    @#对顶级产品进行下级的判断
   
    For i = 1 To mBomTop.Count
        @#最后一个参数为1，表示一个单位的产成品
        Call CalcNextBom(mBomTop.Item(i), mBomTop.Item(i), "1")
    Next i
   
   
    @#最终得以mBomReturn，这里面已初步形成了结果了
   
    @#再进行表达式计算，得到的值返回到mBomReturnLast中，注：mBomReturnLast这个集合加入cBomValue内容
   
   
    For i = 1 To mBomReturn.Count
        @#处理一下最终结果，如果没有在Collection里面发现相同的AssBom及BomPoint，则新增加一个，如果已发现，仅只是数量相加
        Set m = mBomReturn(i)
       
        @#查找是否已加入
        bFind = False
        For j = 1 To mBomReturnLast.Count
            Set mLast = mBomReturnLast(j)
           
            If Trim(mLast.AssBom) = Trim(m.AssBom) And Trim(mLast.BomPoint) = Trim(m.BomPoint) Then
                @#如果发现有相同的，则加入相关数字
                mLast.Quantity = mLast.Quantity + CalcExpression(m.Expression)
                bFind = True
            End If
           
        Next j
       
        If bFind = False Then
            @#如果没有找到
            Set mLast = New cBomValue
            mLast.AssBom = Trim(m.AssBom)
            mLast.BomPoint = Trim(m.BomPoint)
            mLast.Quantity = CalcExpression(Trim(m.Expression))
           
            mBomReturnLast.Add mLast
           
        End If
    Next i
   
    @#所有操作完毕
End Sub

Private Sub LoadBomTop(ByRef BomTop As Collection)
    @#装入顶级产成品，并返回到BomTop中
    @#即存储过程中GetBomList中的第一个游标的创建@bomTop
   
    Dim i As Integer
    Dim j As Integer
    Dim n As Integer
   
   
    Dim bMark As Boolean    @#这只是一个标识符，表明是否发现非顶级
    Dim bMarkAdd As Boolean @#用于判断是否已加入到BomTop中的标识
   
   
    @#判断方法，如果AssBom不在BomPoint中，那就是顶级了
    Dim sBomAssBom As String
   
    For i = 1 To mBom.Count
        sBomAssBom = Trim(mBom.Item(i).AssBom)
       
        @#再进行循环
        bMark = False
       
        For j = 1 To mBom.Count
            If sBomAssBom = Trim(mBom.Item(j).BomPoint) Then
                bMark = True
            End If
        Next j
       
        If bMark = False Then
            @#如果没有发现有相同的，则BomTop加入
           
            @#加入前需要进行判断是否已加入
           
            For n = 1 To BomTop.Count
                If BomTop.Item(n) = sBomAssBom Then
                    bMarkAdd = True
                End If
            Next n
           
            If bMarkAdd = False Then
                @#如果没有加入过，则加入
                BomTop.Add sBomAssBom
            End If
        End If
    Next i
   
   
End Sub


@#GetBomTrueList的存储过程用VB来描述
Private Sub CalcNextBom(sAssBom As String, sAssPoint As String, sExp As String)
    Dim dQuan As Double
    Dim sExpression As String
    Dim sPoint As String
   
    Dim BomTop As String
   
    @#创建point_cursor处的游标
    Dim mBomPoint As Collection
   
    Set mBomPoint = New Collection
   
   
    @#装入相关的集合
    Call LoadNextPoint(mBomPoint, sAssPoint)
   
    @#装入完毕后，再进行判断是否为明细级半成品，如果不是，递归一次本函数，如果是，加入到mBomReturn里面去
   
    Dim i As Integer
    Dim mBomReturnValue As cBomReturnValue
   
    For i = 1 To mBomPoint.Count
        @#判断是否为明细级
        If IsDetailPoint(Trim(mBomPoint.Item(i).BomPoint)) = True Then
            @#如果是明细级，则加入到cBomReturnValue
            Set mBomReturnValue = New cBomReturnValue
            mBomReturnValue.AssBom = Trim(sAssBom)
            mBomReturnValue.BomPoint = Trim(mBomPoint.Item(i).BomPoint)
            @#构建表达式
            mBomReturnValue.Expression = sExp & "*" & Trim(CStr(mBomPoint.Item(i).Quantity))
           
            mBomReturnValue.Quantity = mBomPoint.Item(i).Quantity
           
           
            @#加入
            mBomReturn.Add mBomReturnValue
       
        Else
           
            @#如果不是明细项，则再次递归，注意传入的第一个参数，总是顶级Bom，仅作标识符用
            Call CalcNextBom(sAssBom, Trim(mBomPoint.Item(i).BomPoint), sExp & "*" & Trim(CStr(mBomPoint.Item(i).Quantity)))
        End If
           
    Next i
   
   
       
End Sub

Private Sub LoadNextPoint(ByRef BomPoint As Collection, ByVal PointName As String)
@#相当于GetBomTrueList中的游标中的select distinct point,sl from te where Assbom = @pointName

    Dim i As Integer
    Dim j As Integer
   
    Dim bMark As Boolean
    Dim mPointValue As cPointValue
                   
    For i = 1 To mBom.Count
        bMark = False
        If Trim(mBom.Item(i).AssBom) = Trim(PointName) Then
            @#判断是否已加入
            For j = 1 To BomPoint.Count
                If Trim(BomPoint.Item(j).BomPoint) = Trim(mBom.Item(i).BomPoint) And BomPoint.Item(j).Quantity = mBom.Item(i).Quantity Then
                    bMark = True
                End If
            Next j
            If bMark = False Then
                @#表示没有加入
                Set mPointValue = New cPointValue
                mPointValue.BomPoint = Trim(mBom.Item(i).BomPoint)
                mPointValue.Quantity = mBom.Item(i).Quantity
                BomPoint.Add mPointValue
            End If

        End If
    Next i
   
   

End Sub

Private Function IsDetailPoint(ByVal PointName As String) As Boolean
@#判断是否为底级半成品

    @#只需要判断PointName不在mBom的AssBom项中即可
   
    Dim i As Integer
   
    For i = 1 To mBom.Count
        If Trim(mBom.Item(i).AssBom) = Trim(PointName) Then
            @#如果找到了，直接返回False，并退出函数
            IsDetailPoint = False
            Exit Function
        End If
    Next i
   
    @#如果到了这里还没有找到，那么就肯定是底级了
    IsDetailPoint = True
End Function

Public Function CalcExpression(strExp As String) As Double
@#计算处理中的表达式，注意，只有乘法


Dim sItemExp() As String

Dim dReturnValue As Double
Dim iIndex As Integer

sItemExp = Split(Trim(strExp), "*")


If UBound(sItemExp) < 0 Then
    CalcExpression = 0
Else

    dReturnValue = 1
    For iIndex = 0 To UBound(sItemExp)
        If Trim(sItemExp(iIndex)) = "" Then
            sItemExp(iIndex) = 0
        End If
       
       
        dReturnValue = dReturnValue * CDbl(sItemExp(iIndex))
    Next iIndex
   
    CalcExpression = dReturnValue
   


End If

End Function




类模块一：类名：cBomReturnValue

Option Explicit

@#保持属性值的局部变量
Private mvarAssBom As String @#局部复制
Private mvarBomPoint As String @#局部复制
Private mvarQuantity As Double @#局部复制
Private mvarExpression As String @#局部复制
Public Property Let Expression(ByVal vData As String)
@#向属性指派值时使用，位于赋值语句的左边。
@#Syntax: X.Expression = 5
    mvarExpression = vData
End Property


Public Property Get Expression() As String
@#检索属性值时使用，位于赋值语句的右边。
@#Syntax: Debug.Print X.Expression
    Expression = mvarExpression
End Property



Public Property Let Quantity(ByVal vData As Double)
@#向属性指派值时使用，位于赋值语句的左边。
@#Syntax: X.Quantity = 5
    mvarQuantity = vData
End Property


Public Property Get Quantity() As Double
@#检索属性值时使用，位于赋值语句的右边。
@#Syntax: Debug.Print X.Quantity
    Quantity = mvarQuantity
End Property



Public Property Let BomPoint(ByVal vData As String)
@#向属性指派值时使用，位于赋值语句的左边。
@#Syntax: X.BomPoint = 5
    mvarBomPoint = vData
End Property


Public Property Get BomPoint() As String
@#检索属性值时使用，位于赋值语句的右边。
@#Syntax: Debug.Print X.BomPoint
    BomPoint = mvarBomPoint
End Property



Public Property Let AssBom(ByVal vData As String)
@#向属性指派值时使用，位于赋值语句的左边。
@#Syntax: X.AssBom = 5
    mvarAssBom = vData
End Property


Public Property Get AssBom() As String
@#检索属性值时使用，位于赋值语句的右边。
@#Syntax: Debug.Print X.AssBom
    AssBom = mvarAssBom
End Property





类模块二：类名：cBomValue

Option Explicit

@#保持属性值的局部变量
Private mvarAssBom As String @#局部复制
Private mvarBomPoint As String @#局部复制
Private mvarQuantity As Double @#局部复制
Public Property Let Quantity(ByVal vData As Double)
@#向属性指派值时使用，位于赋值语句的左边。
@#Syntax: X.Quantity = 5
    mvarQuantity = vData
End Property


Public Property Get Quantity() As Double
@#检索属性值时使用，位于赋值语句的右边。
@#Syntax: Debug.Print X.Quantity
    Quantity = mvarQuantity
End Property



Public Property Let BomPoint(ByVal vData As String)
@#向属性指派值时使用，位于赋值语句的左边。
@#Syntax: X.BomPoint = 5
    mvarBomPoint = vData
End Property


Public Property Get BomPoint() As String
@#检索属性值时使用，位于赋值语句的右边。
@#Syntax: Debug.Print X.BomPoint
    BomPoint = mvarBomPoint
End Property



Public Property Let AssBom(ByVal vData As String)
@#向属性指派值时使用，位于赋值语句的左边。
@#Syntax: X.AssBom = 5
    mvarAssBom = vData
End Property


Public Property Get AssBom() As String
@#检索属性值时使用，位于赋值语句的右边。
@#Syntax: Debug.Print X.AssBom
    AssBom = mvarAssBom
End Property





类模块三：类名：cPointValue

Option Explicit

@#保持属性值的局部变量
Private mvarBomPoint As String @#局部复制
Private mvarQuantity As Double @#局部复制
Public Property Let Quantity(ByVal vData As Double)
@#向属性指派值时使用，位于赋值语句的左边。
@#Syntax: X.Quantity = 5
    mvarQuantity = vData
End Property


Public Property Get Quantity() As Double
@#检索属性值时使用，位于赋值语句的右边。
@#Syntax: Debug.Print X.Quantity
    Quantity = mvarQuantity
End Property




Public Property Let BomPoint(ByVal vData As String)
@#向属性指派值时使用，位于赋值语句的左边。
@#Syntax: X.BomPoint = 5
    mvarBomPoint = vData
End Property


Public Property Get BomPoint() As String
@#检索属性值时使用，位于赋值语句的右边。
@#Syntax: Debug.Print X.BomPoint
    BomPoint = mvarBomPoint
End Property





加入后可直接在窗体中Print出列表。

原文转自：http://www.ltesting.net