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出列表。

时间： 2024-09-17 04:07:01

BOM表查询的VB实现方法的相关文章

Thinkphp连表查询及数据导出方法示例_php实例

本文实例讲述了Thinkphp连表查询及数据导出的方法.分享给大家供大家参考,具体如下: 这今天实验室的招新工作就要展开了,我们通过实验室网站关联到杭电OJ,大一的新生将他们杭电的用户名在实验室网站提交,网站就会通过网络爬虫到杭电OJ上面进行数据抓取存到实验室数据库. 现在我要做的事就是把新生表和新生OJ数据表联合导出.实验室网站是用thinkphp框架开发的.所以根据以前的工作经验.问题很快就解决了. 现在跟大家分享一下. thinkphp的扩张类都是放在ORG目录下面,在通过import()

Thinkphp连表查询及数据导出方法示例

本文实例讲述了Thinkphp连表查询及数据导出的方法.分享给大家供大家参考,具体如下: 这今天实验室的招新工作就要展开了,我们通过实验室网站关联到杭电OJ,大一的新生将他们杭电的用户名在实验室网站提交,网站就会通过网络爬虫到杭电OJ上面进行数据抓取存到实验室数据库. 现在我要做的事就是把新生表和新生OJ数据表联合导出.实验室网站是用thinkphp框架开发的.所以根据以前的工作经验.问题很快就解决了. 现在跟大家分享一下. thinkphp的扩张类都是放在ORG目录下面,在通过import()

thinkphp多表查询两表有重复相同字段的完美解决方法_php技巧

框架:thinkphp 版本:3.2.3 内容:查询语句 解决问题:重复字段问题 $Data = M('a')->where($where) ->Field('a.name as aname,b.name as uname,a.*') ->join('b on b.jb_id=a.id') ->order('a.id desc') ->select(); 解释:a.* 查询a表所有的字段 a.name as aname 转换a表中的name重复字段为aname 以上就是小编为

SQL重复记录查询 查询多个字段、多表查询、删除重复记录的方法_Mysql

SQL重复记录查询 1.查找表中多余的重复记录,重复记录是根据单个字段(peopleId)来判断  select * from people where peopleId in (select peopleId from people group by peopleId having count(peopleId) > 1) 例二:  select * from testtable where numeber in (select number from people group by numb

thinkPHP多表查询及分页功能实现方法示例

本文实例讲述了thinkPHP多表查询及分页功能实现方法.分享给大家供大家参考,具体如下: 项目业务逻辑为:教师上传试卷,设置答题卡,发布答题卡给相关的班级或群组,只有试卷关联的答题卡发布后,该试卷才能在系统试卷中搜索到,同时其他的老师也可以收藏.在前端的收藏模块中,有个业务是给个input框以提供搜索功能给用户,但是在事先设计的搜索表中,只有一处试卷ID是和试卷表关联的,如果用户搜索试卷题目那岂不要两表查询了,一开始我想到的方法是在收藏表中多加个字段,也就是把试卷题目的字段添加到收藏表中,业务

MyBatis学习教程(五)-实现关联表查询方法详解_java

一.一对一关联  1.1.提出需求 根据班级id查询班级信息(带老师的信息) 1.2.创建表和数据 创建一张教师表和班级表,这里我们假设一个老师只负责教一个班,那么老师和班级之间的关系就是一种一对一的关系. CREATE TABLE teacher( t_id INT PRIMARY KEY AUTO_INCREMENT, t_name VARCHAR() ); CREATE TABLE class( c_id INT PRIMARY KEY AUTO_INCREMENT, c_name VAR

sql多表查询语句与方法

下面使用等值连接列出authors和publishers表中位于同一城市的作者和出版社: Select * FROM authors AS a INNER JOIN publishers AS p ON a.city=p.city   又如使用自然连接,在选择列表中删除authors 和publishers 表中重复列(city和state) : Select a.*,p.pub_id,p.pub_name,p.country FROM authors AS a INNER JOIN publi

Yii2中多表关联查询hasOne hasMany的方法

表positionContent id position_id content_title content_id is_recommend list_sort update_time create_time 10 14 大成成长 160910 1 1 2017-02-09 11:51:56 2017-02-09 11:51:56 11 15 创新成长 160910 1 1 2017-02-09 11:52:08 2017-02-09 11:52:08 position表 id name titl

Mysql5 实现交叉表查询

交叉表.行列转换和交叉查询经典 一.什么是交叉表 "交叉表"对象是一个网格,用来根据指定的条件返回值.数据显示在压缩行和列中.这种格式易于比较数据并辨别其趋势.它由三个元素组成: 行 列 摘要字段 "交叉表"中的行沿水平方向延伸(从一侧到另一侧).在上面的示例中,"手套"(Gloves) 是一行. "交叉表"中的列沿垂直方向延伸(上下).在上面的示例中,"美国"(USA) 是一列. 汇总字段位于行和列的交叉