通过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、  重1、2过程，直到读完所有记录。

 

数据表竖专横算法：

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源码网店