'Import_WeeklyMachining_Schedule 导入 生产计划 Import_WeeklyMachineSchedule V2 通过字典
'源数据"P:\PMS\Weekly producion Schedule\Weekly production Schedule.xlsm"
Dim TableN As String = "WeeklyMachineSchedule"
Dim yn As Integer
If Not DataTables.Contains(TableN) Then
DataTables.Load(tablen)
yn = 1
End if
DataTables(TableN).LoadFilter = "" ' "Process_Completed = false"
DataTables(TableN).Load
'DataTables(TableN).DeleteFor("WO not like '%WO'")
Dim fp As String = "P:\General documents\Worktime Data\Fox Data\Query\"
Dim ff = "Weekly Machine Schdule.xlsx"
Dim fpf As String = fp & ff
Dim cg As Boolean = True
Dim s1 As Date
Dim s2 As Date
Dim s3 As TimeSpan
If filesys.FileExists(fpf) Then
Tables(TableN).StopRedraw '停止屏幕刷新
Dim cn As String '列名称
Dim i As Integer
Dim App As New MSExcel.Application
App.DisplayAlerts = False
App.visible = True
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(fpf)
s1 = Date.Now
Wb.RefreshAll
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
Dim Rs As Integer = Ws.Range("A15000").End(MSExcel.XlDirection.xlup).Row
Dim Cs As Integer = 50
Dim Rg As MSExcel.Range = Ws.Range("A1")
Rg = Rg.Resize(Rs, cs)
'Dim cs As Integer = Rg.Columns.Count
Dim ary = Rg.value
Dim c As Integer
Dim bh As Boolean
Dim Dic_Ext As New Dictionary(Of DataRow, Integer)
Dim Dic_New As New Dictionary(Of DataRow, Integer)
SystemReady = False '停止所有其它程序
Dim i1 As Integer = 0
Dim Filter As String
Dim d1 As New Dictionary(Of String, DataRow)
'预设WOp 入字典
For Each dr1 As DataRow In DataTables("WeeklyMachineSchedule").DataRows
Dim wop As String = dr1("WO") & dr1("OP")
If Not d1.ContainsKey(wop) Then
d1.add(wop, dr1)
Else
dr1.Delete
End If
Next
Dim zwo As String
For i = 2 To Rs
'If ARY(i, 5) = "IWO89801/1" Then Output.Show("i=" & i & "; op:" & ary(i, 35) & " Filter:=" & "[WO] = '" & ary(i, 5) & "' and [OP] = " & ary(i, 35))
'Filter = "[WO] = '" & ary(i, 5) & "' and [OP] = " & ary(i, 35) 'wop
'Dim dr As DataRow = DataTables(TableN).Find(Filter)
Dim wop As String = ary(i, 5) & ary(i, 35)
If Not d1.ContainsKey(wop) Then
Dim dr As DataRow = DataTables("WeeklyMachineSchedule").AddNew '新增数据行
i1 = i1 + 1
Dic_New.Add(dr, i)
Else '已经存在的数据行,须判断是否有修改,简化操作改为直接重写
bh = False '初始值
Dim dr As DataRow = d1(wop)
For c = 1 To cs'
cn = ary(1, c) '列名
If dr(cn) <> ary(i, c) Then
bh = True
Exit For
End If
Next
If bh = True Then
If Dic_Ext.ContainsKey(dr) = False Then '是否存在键
Dic_Ext.Add(dr, i)
i1 = i1 + 1
End If
End If
End If
If InStr(ary(i, 5), "Z") > 0 Then
If zwo = "" Then
zwo = ary(i, 5)
Else
zwo = zwo & "','" & ary(i, 5)
End If
End If
Next
If Dic_New.Count > 0 Then
For Each dr As DataRow In Dic_New.Keys
i = Dic_New(dr)
For c = 1 To cs
cn = ary(1, c)
If cn = "RequiredHours" OrElse cn = "Delay_Days" Then
dr(cn) = Round2(ary(i, c), 2)
ElseIf cn = "RM_RequiredQty" Then
dr(cn) = Round2(ary(i, c), 1)
Else
dr(cn) = ary(i, c)
End If
Next
dr("TaskDate") = Date.Today
Next
End If
If Dic_Ext.Count > 0 Then
For Each dr1a As DataRow In Dic_Ext.Keys
i = Dic_Ext(dr1a)
For c = 1 To cs
cn = ary(1, c)
If cn = "RequiredHours" OrElse cn = "Delay_Days" Then
dr1a(cn) = Round2(ary(i, c), 2)
ElseIf cn = "RM_RequiredQty" Then
dr1a(cn) = Round2(ary(i, c), 1)
Else
dr1a(cn) = ary(i, c)
End If
Next
Next
End If
'删除不再存在的Z工单
If zwo > "" Then
zwo = "('" & zwo & "')"
DataTables("WeeklyMachineSchedule").DeleteFor("wo like 'Z%' and WO not in " & zwo)
End If
SystemReady = True
App.quit
End If
Dim dt1 As DataTable = DataTables("Data")
Dim dr1c As DataRow = DataTables("Data").Find("文件更新_文件名 = '" & ff & "'")
Tables(TableN).ResumeRedraw '屏幕恢复刷新
Tables(TableN).Sort = "PartNumber"
Tables("Data").Sort = "文件更新_时间 Desc"
s2 = Date.Now
s3 = s2 - s1
Output.Show(s1 & " -- " & s2 & " Import_WeeklyMachining_Schedule 刷新 总计经过时间s:" & s3.TotalSeconds)
dr1c("SpentTime") = Round2(s3.TotalSeconds, 2)
dr1c("文件更新_文件名") = ff
dr1c("文件更新_时间") = Date.Now
dr1c.Save
DataTables(TableN).Save
If yn = 1 Then DataTables.Unload(TableN)
加好友 
发短信
Post By：2024/1/17 12:45:00 [显示全部帖子]
