[求助]SAP BOM新旧对比算法优化

Benjamin_luk

应该公司要求, 每个月需要对BOM进行审核
大概方案是本月审核完后,将作为下个月的参考资料;
两个月的BOM进行对比,找出变更的内容; 按变更内容查相关文件,没文件支持的作为非法改动.
现在主要是想在算法上进行优化, 现在用和算法如下,所有改动用数组记录,然后记录到BOM的表头里
希望大家能提供更好的思路
BOM数据直接用RFC从SAP下载

Function DCL_BOMAudit(Pre_Month As String, Cur_Month As String)
Dim rs1 As Recordset, rs2 As Recordset
Dim rs3 As Recordset, rs4 As Recordset
Dim Result(1, 10), Xtmp(1, 30), n As Integer, J As Integer, GetAudit, L As Integer, K As Integer, H As Integer
Dim CurAuditData As String
Dim CurBOMData As String
Dim PreAuditData As String
Dim PreBOMData As String
Dim Comp1 As String, Comp2 As String, UQty1 As String, UQty2 As String, UUom1 As String, UUom2 As String
Dim rs5 As Recordset
CurAuditData = Cur_Month & "_AuditData" '本月BOM表头
CurBOMData = Cur_Month & "_BOMData" '本月BOM明细
PreAuditData = Pre_Month & "_AuditData"'上月BOM明细
PreBOMData = Pre_Month & "_BOMData"'上月BOM明细
'--------------------BOM Header Checking---------
Result(0, 0) = "New BOM Creation/新建立的BOM,"
Result(0, 1) = "Header Base Quantity Changed/基数已变," 'Base_Qty
Result(0, 2) = "Header Base Unit Changed/基数单位已变," 'Base_Unit
Result(0, 3) = "BOM Status Changed/BOM状态已变,"
Result(0, 4) = "Delete Flag Set/BOM已设为删除," 'Delete_Flag
Result(0, 5) = "Delete Flag Remove/BOM已取消删除,"
'--------------------BOM Component Checking---------
Result(1, 1) = "Component Deleted/料件已被删除,"
Result(1, 2) = "New Component Added/新料件增加,"
Result(1, 3) = "BOM Usage Quantity Changed/料件BOM用量变小,"
Result(1, 4) = "BOM Usage Quantity Changed/料件BOM用量变大,"
Result(1, 5) = "Usage Unit Changed/料件用量单位已变,"
'--------------------Table Checking-----------------
If FTbl(CurAuditData) = False Then
MsgBox "请按步骤下载SAP数据并生成审核文档", vbCritical, "找不到BOM审核文档"
Exit Function
ElseIf FTbl(PreAuditData) = False Then
MsgBox "这是第一次进行BOM审核,请全部进行人工审核", vbCritical, "需要手工审核"
Exit Function
ElseIf FTbl(CurBOMData) = False Then
MsgBox "请按步骤下载SAP数据并生成审核文档", vbCritical, "找不到BOM审核文档"
Exit Function
ElseIf FTbl(PreBOMData) = False Then
MsgBox "这是第一次进行BOM审核,请全部进行人工审核", vbCritical, "需要手工审核"
Exit Function
End If
'========================BOM Header Data Checking====================
Set rs1 = CurrentDb.OpenRecordset(CurAuditData)
If rs1.RecordCount > 0 Then
rs1.MoveFirst
Do Until rs1.EOF
Erase Xtmp
Set rs3 = CurrentDb.OpenRecordset("select * from " & PreAuditData & " where [Bom_Index]='" & rs1("Bom_Index") & "'")
If rs3.RecordCount = 0 Then
Xtmp(0, 1) = "0-0:" & Result(0, 0)
Else
        '--------------Check if Base_Quantity Changed----------------
          If StrComp((rs1("Base_Qty")), rs3("Base_Qty"), 0) <> 0 Then
          Xtmp(0, 1) = "0-1:" & Result(0, 1) & CDbl(rs3("Base_Qty")) & "," & "->" & CDbl(rs1("Base_Qty"))
          End If
         '--------------Check if Base_Unit Changed----------------
          If StrComp(rs1("Base_Unit"), rs3("Base_Unit"), 0) <> 0 Then
          Xtmp(0, 2) = "0-2:" & Result(0, 2) & rs1("Base_Unit") & "," & " ->  " & rs3("Base_Unit")
          End If
          '--------------Check if Base_Status Changed----------------
          If StrComp(rs1("BOM_Status"), rs3("BOM_Status"), 0) <> 0 Then
          Xtmp(0, 3) = "0-3:" & Result(0, 3) & rs1("Delete_Flag") & "," & " ->  " & rs3("Delete_Flag")
          End If
          '--------------Check if Delete_Flag Changed----------------
          If StrComp(Nz(rs1("Delete_Flag"), 88), Nz(rs3("Delete_Flag"), 88), 0) <> 0 And rs3("Delete_Flag") = "X" Then
          Xtmp(0, 4) = "0-4:" & Result(0, 4) & rs1("Delete_Flag") & "," & " ->  " & rs3("Delete_Flag")
          ElseIf StrComp(Nz(rs1("Delete_Flag"), 88), Nz(rs3("Delete_Flag"), 88), 0) <> 0 And rs1("Delete_Flag") = "X" Then
          Xtmp(0, 4) = "0-5:" & Result(0, 5) & rs1("Delete_Flag") & "," & " ->  " & rs3("Delete_Flag")
          End If
'=======================BOM Component Data Checking=========================
          Set rs2 = CurrentDb.OpenRecordset("select * from " & CurBOMData & " where [Bom_Index]='" & rs1("Bom_Index") & "' Order by Component")
          Set rs4 = CurrentDb.OpenRecordset("select * from " & PreBOMData & " where [Bom_Index]='" & rs1("Bom_Index") & "' Order by Component")
             Comp1 = ""
             UQty1 = ""
             UUom1 = ""
             Comp2 = ""
             UQty2 = ""
             UUom2 = ""
            If rs2.RecordCount > 0 Then
            rs2.MoveFirst
            Do Until rs2.EOF
            Comp1 = Comp1 & rs2("Component") & ";"
            UQty1 = UQty1 & rs2("Usage_Qty") & ";"
            UUom1 = UUom1 & rs2("U_UoM") & ";"
            rs2.MoveNext
            Loop
            End If
            If rs4.RecordCount > 0 Then
            rs4.MoveFirst
            Do Until rs4.EOF
            Comp2 = Comp2 & rs4("Component") & ";"
            UQty2 = UQty2 & rs4("Usage_Qty") & ";"
            UUom2 = UUom2 & rs4("U_UoM") & ";"
            rs4.MoveNext
            Loop
            End If
            'Marked BOM Header changed or Component Changed
            If StrComp(Comp1 & UQty1 & UUom1, Comp2 & UQty2 & UUom2, 0) <> 0 Then
            Xtmp(1, 0) = "---:" & "BOM Component Changed Details/BOM明细修改信息:"
            n = 0
            rs4.MoveFirst
            '------Check if component is deleted----
                    Do Until rs4.EOF
                    If InStr(1, Comp1, rs4("Component"), 0) = 0 Then
                    n = n + 1
                    Xtmp(1, n) = "1-1:" & Result(1, 1) & rs4("Component")
                    End If
                    rs4.MoveNext
                    Loop
            '------Check if component is new created----
                    rs2.MoveFirst
                    
                    Do Until rs2.EOF
                    
                        If InStr(1, Comp2, rs2("Component"), 0) = 0 Then
                        Xtmp(1, n) = "1-2:" & Result(1, 2) & rs2("Component")
                        '------Check if Usage_Qty & Usage_Unit Changed
                        Else
                        n = n + 1
                        Set rs5 = CurrentDb.OpenRecordset("select * from " & PreBOMData & " where [Bom_Index]='" & rs1("Bom_Index") & "' and [Component]=" & rs2("Component") & "")
                            Select Case StrComp(rs2("Usage_Qty"), rs5("Usage_Qty"), 0)
                            Case -1
                            Xtmp(1, n) = "1-3:" & Result(1, 3) & rs2("Component") & "," & rs5("Usage_Qty") & "," & "->" & rs2("Usage_Qty")
                            Case 1
                            Xtmp(1, n) = "1-4:" & Result(1, 4) & rs2("Component") & "," & rs5("Usage_Qty") & "," & "->" & rs2("Usage_Qty")
                            End Select
                           
                            Select Case StrComp(rs2("U_UoM"), rs5("U_UoM"), 0)
                            Case -1
                            Xtmp(1, n + 1) = "1-5:" & Result(1, 5) & rs2("Component") & "," & rs5("U_Uom") & "," & "->" & rs2("U_Uom")
                            Case 1
                            Xtmp(1, n + 1) = "1-5:" & Result(1, 5) & rs2("Component") & "," & rs5("U_Uom") & "," & "->" & rs2("U_Uom")
                            End Select
                        End If
                    rs2.MoveNext
                    Loop
            
            End If
End If
For K = 0 To 1
For J = 0 To 30
If Xtmp(K, J) <> "" And IsNull(Xtmp(K, J)) = False Then
GetAudit = GetAudit & Xtmp(K, J) & vbCrLf
Xtmp(K, J) = Null
End If
Next J
Next K
If InStr(1, GetAudit, "0-0") = 0 And InStr(1, GetAudit, "0-") > 0 Then
GetAudit = "--" & H & ":BOM Header Changed Details/BOM表头信息修改如下:" & vbCrLf & GetAudit
End If
rs1.Edit
If Len(Trim(GetAudit)) > 0 Then
rs1("Hit_Miss") = "M"
Else
rs1("Hit_Miss") = "H"
End If
rs1("Audit_Result") = GetAudit
rs1("Audit_By") = TNumber
rs1("Audit_Date") = Date
rs1.Update
GetAudit = Null
rs1.MoveNext
Loop
MsgBox "BOM Auto-Checking Completed/BOM自动审核部分已完成", vbInformation, "Checking Completed/检查完成"
Else
MsgBox "请按步骤下载SAP数据并生成审核文档", vbCritical, "找不到BOM审核数据"
End If

Set rs1 = Nothing
Set rs2 = Nothing
Set rs3 = Nothing
Set rs4 = Nothing
Set rs5 = Nothing
End Function

Function LssfK()
DCL_BOMAudit "201005", "201006"
End Function