时　间:2009-08-31 00:00:00

作　者:摘　要: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 mGROUP 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交流群(群号:39785885)

Access源码网店