Access开发培训
网站公告
·Access专家课堂QQ群号:151711184    ·Access快速开发平台下载地址及教程    ·欢迎加入Access专家课堂微信群!    ·如何快速搜索本站文章|示例|资料    
您的位置: 首页 > 技术文章 > 生产应用

通过access 实现 Oracle ERP MPS 转换排产

时 间:2009-08-31 00:00:00
作 者:一鸣   ID:5989  城市:深圳
摘 要:Oracle ERP MPS 的调整对供应链计划起着至关重要的作用。而Oracle ERP 中的MPS 调整是对每一个料(编码)逐行不同日期进行调整其MPS 数量。当编码多、滚动计划时间长的时候,就存在一个非常麻烦的问题——调整的时候无法对某个料进行直观的调整,以及对不同编码以不同分组进行汇总、调整;希望能通过针对每一个编码为一行记录,相应的不同日期的MPS 数量,以日期为列放在同一行的相应列,这样调整适合大量的编码及长时间的滚动计划的调整。
正 文:



一、需求分析

 

Oracle ERP MPS 的调整对供应链计划起着至关重要的作用。而Oracle ERP 中的MPS 调整是对每一个料(编码)逐行不同日期进行调整其MPS 数量。当编码多、滚动计划时间长的时候,就存在一个非常麻烦的问题——调整的时候无法对某个料进行直观的调整,以及对不同编码以不同分组进行汇总、调整;希望能通过针对每一个编码为一行记录,相应的不同日期的MPS 数量,以日期为列放在同一行的相应列,这样调整适合大量的编码及长时间的滚动计划的调整。

 

二、ACCESS 实现思路

 

1、将需要调整的MPS ERP 中下载到EXCLE 表格中命名为”MPS”(见表一)

表一:

MPS

ID

Segment1

Description

Schedule Quantity

shipdate

Planner Code

Original Schedule Quantity

1

01300042

空调机-DME07MO1-DATAMATE3000带电加热7kW机组/室内机-{R5}

5

01/06/2010

HPAC_02

5

2

01300042

空调机-DME07MO1-DATAMATE3000带电加热7kW机组/室内机-{R5}

5

01/20/2010

HPAC_02

5

66

01300043

空调机-DME12MC1-DATAMATE3000单冷12kW机组/室内机-{R5}

20

12/23/2009

HPAC_02

20

 

 

2、  ”MPS”导入ACCESS

3、  利用更新查询”MPSWS””MPS”表中字段”shipdate”日期值转换为所在滚动周字段”WEEKS”的值,如字段”shipdate”值为”01/06/2010”转换为滚动的周”WEEKS”的值为18(转换函数为:funWeeks(ByVal prDate As Date)

4、将查询”MPSWS”的结果追加到空的系统表”MPS_adjust”(见表二)中

表二:


5
、将已追加数据的表”MPS_adjust”利用更新查询根据”WEEKS”的值将”Schedule Quantity”赋予到同行对应的列日期字段值,结果见表三。
表三:

6、  将表三安装”item”进行汇总查询,设计的字段及结果表见表四
表四:

7、  在表四中进行人工调整MPS

8、  将要人工调整的MPS 逆向转换为导入ERP 格式的表”ERP_IM”见表五(类似从ERP下载的表”MPS”)——其算法为算法二
表五:

9、将表”ERP_IM”导入ERP ,MPS 调整完成!

 

三、重点算法:

 

数据表格横转竖算法:

 

1、  读取一条记录,保存一个临时的数据类型结构里

2、  进行53此循环赋值到一个新输出表中

a)         将记录的字段1,重复赋值到新表中的字段1

b)         从第5个字段开始,程序自动计算以其为基准作为W1的周三,以周为单位(7天)赋值给新表的字段2;并从字段5开始将其字段值逐记录赋值给新表的字段3.

3、  12过程,直到读完所有记录。

 

数据表竖专横算法:

1、  建立一个最新的空的结构新横表

2、  将所有的竖表中的时间通过更新SQL在一列中放置该行所在的周数据

3、  item字段值为分组读取所在周的数据,据其将数量字段的值放到横表中

 

四、逻辑图表:

 

五、代码:

 

窗体”MAIN”的代码:

Option Compare Database

Private Sub Command0_Click()

 

    If ERPIM Then MsgBox "数据转换完毕", vbInformation, "操作提示"

End Sub

 

 

'*******************************************************

'

'****函数名称:ERPIM

'********参数:无

'********功能:根据表”MPS_adjustx”生成导入ERP所使用的表”ERP_IM”

'********作者:一鸣

'********日期:2009-08-30

'*******Email NET0112@126.COM

'****更新日期:2009--8-30

'

'********************************************************

 

Private Function ERPIM() As Boolean

 

    Dim i As Integer

    Dim dateTmp As Date

 

    On Error GoTo ERPIM_Error

 

    dateTmp = modCommon.funDBase

 

    Dim CN As ADODB.Connection

    Dim rsA As ADODB.Recordset

    Dim rsB As ADODB.Recordset

    Set rsA = New ADODB.Recordset

    Set rsB = New ADODB.Recordset

    Set CN = CurrentProject.Connection

 

    DoCmd.SetWarnings False

    DoCmd.RunSQL "Delete ERP_IM.* FROM ERP_IM "

    rsA.Open "MPS_adjustx", CN, adOpenDynamic, adLockReadOnly

    rsB.Open "ERP_IM", CN, adOpenDynamic, adLockOptimistic

    rsA.MoveFirst

 

    rsB.AddNew

    Do While Not rsA.EOF

        dateTmp = funDBase()

        For i = 1 To 53

            With rsB

                If rsA.Fields(i + 3) > O Then

                    .Fields(0) = rsA!Item

                    .Fields(2) = rsA.Fields(i + 3)

                    .Fields(1) = dateTmp

                    .Update

                    .AddNew

                End If

                dateTmp = dateTmp + 7

            End With

        Next

        rsA.MoveNext

    Loop

    rsA.Close

    'rsB.Close

    Set rsA = Nothing

    Set rsB = Nothing

    Set CN = Nothing

 

    'DoCmd.RunSQL "Delete * FROM ERP_IM Where (((ERP_IM.quantity)=0)) "

    DoCmd.SetWarnings True

    DoCmd.TransferText acExportDelim, , "ERP_IM", CurrentProject.Path & "\ABC.CSV", True

    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel5, "ERP_IM", CurrentProject.Path & "\ERP_IM" & Date & ".XLS"

 

    'MsgBox "数据转换完毕", vbInformation, "操作提示"

    ERPIM = True

 

ERPIM_Exit:

    Exit Function

ERPIM_Error:

    MsgBox Err.Number & Space(5) & Err.Description, vbCritical, "出错啦!"

    ERPIM = False

    Resume ERPIM_Exit

End Function

 

'*******************************************************

'

'****过程名称:ERPEX

'********参数:无

'********功能:根据查询”MPSWS”生成表”MPS_adjust”,并更新每行中WEEK0~WEEK53中的值

'********作者:一鸣

'********日期:2009-08-30

'*******Email NET0112@126.COM

'****更新日期:2009--8-30

'

'********************************************************

 

Private Function ERPEX() As Boolean

 

    Dim i As Integer

    Dim CN As ADODB.Connection

    Dim rsA As ADODB.Recordset

 

    DoCmd.SetWarnings False

 

    DoCmd.RunSQL " delete * FROM MPS_adjust "

    DoCmd.RunSQL " Insert INTO MPS_adjust ( item, descr, [Schedule Quantity], shipdate, plan, weeks ) " _

               & " Select MPSWS.Segment1, MPSWS.Description, MPSWS.[Schedule Quantity], MPSWS.shipdate, MPSWS.[Planner Code], MPSWS.weeks " _

               & " FROM MPSWS "

 

    Set CN = CurrentProject.Connection

    Set rsA = New ADODB.Recordset

 

    rsA.Open "MPS_adjust", CN, adOpenDynamic, adLockOptimistic

    rsA.MoveFirst

    Do While Not rsA.EOF

        rsA.Fields(rsA.Fields(5) + 7) = rsA.Fields(2)

        rsA.Update

        rsA.MoveNext

    Loop

    rsA.Close

    Set rsA = Nothing

    Set CN = Nothing

 

    Call funDates

 

    ERPEX = True

 

    DoCmd.SetWarnings True

 

End Function

 

 

'*******************************************************

'

'****过程名称:funDates

'********参数:无

'********功能:根据表”MPS_adjust”生成人工调整MPS的表”MPS_adjustx”

'********作者:一鸣

'********日期:2009-08-30

'*******Email NET0112@126.COM

'****更新日期:2009--8-30

'

'********************************************************

 

Private Sub funDates()

 

    Dim strWeeks(53) As String

    Dim i As Integer

    Dim strSql As String

    strSql = ""

    dateTmp = funDBase()

    strWeeks(0) = "过期计划"

 

    For i = 1 To 53

        strWeeks(i) = Format(dateTmp + (i - 1) * 7, "mmm_dd")

    Next

 

    For i = 0 To 52

        strSql = strSql & "Sum(m.week" & i & ") AS " & strWeeks(i) & ","

    Next

 

    strSql = strSql & "Sum(m.week" & 53 & ") AS " & strWeeks(53)

    strSql = strSql & " into MPS_adjustx "

    strSql = "Select m.item, m.descr, m.plan," & strSql & "FROM MPS_adjust AS m  GROUP BY m.item, m.descr, m.plan;"

    DoCmd.RunSQL strSql

 

End Sub

 

 

Private Sub Command1_Click()

 

    If ERPEX Then MsgBox "数据转换完毕", vbInformation, "操作提示"

 

End Sub

 

 

ModCommon 模块代码

 

Option Compare Database

 

'*******************************************************

'

'****函数名称:funDBase

'********参数:无

'********功能:根据当前日期换算出以周三为基准的W1日期

'********作者:一鸣

'********日期:2009-08-30

'*******Email NET0112@126.COM

'****更新日期:2009--8-30

'

'********************************************************

 

Public Function funDBase() As Date

 

    Select Case Weekday(Date)

 

    Case 1         ' &&当前日期是周日

        funDBase = Date + 10

    Case 2         ' &&当前日期是周一

        funDBase = Date + 9

    Case 3         ' &&当前日期是周二

        funDBase = Date + 8

    Case 4         ' &&当前日期是周三,以下周周三为基准

        funDBase = Date + 7

    Case 5         ' &&当前日期是周四

        funDBase = Date + 6

    Case 6        '  &&当前日期是周五

        funDBase = Date + 12

    Case 7        '  &&当前日期是周六

        funDBase = Date + 11

 

    End Select

 

End Function

'*******************************************************

'

'****函数名称:funWeeks

'********参数:日期 prDate

'********功能:根据日期prDate换算出其所在的滚动的周数

'********作者:一鸣

'********日期:2009-08-30

'*******Email NET0112@126.COM

'****更新日期:2009--8-30

'

'********************************************************

Public Function funWeeks(ByVal prDate As Date) As Integer

 

    Dim i As Integer

    Dim dateTmpbase As Date

    dateTmpbase = funDBase()

    If prDate > funDBase Then

        For i = 1 To 53

            If prDate >= dateTmpbase And prDate < dateTmpbase + 7 Then

                funWeeks = i

                Exit For

            End If

            dateTmpbase = dateTmpbase + 7

        Next

    Else

        funWeeks = 0

    End If

End Function

 

附件示例下载:

点击下载此附件



Access软件网QQ交流群 (群号:54525238)       Access源码网店

常见问答:

技术分类:

相关资源:

专栏作家

关于我们 | 服务条款 | 在线投稿 | 友情链接 | 网站统计 | 网站帮助