'本表的算法分析
'將不良品日報表本月的內容和本月維修匯總表格本月的內容加總,同時將不良品匯總表格上月的存量壹起累計出本月的存量
'為了程序的編寫方便,不考慮不良品匯總表格的上月內容,實際使用時將其直接從上月拷貝過來使用即可
'這個算法是借用了字典新的item增加是往下加的效果,因此不能高錯亂了,因為上月存量是與料號是壹壹對應的
'不統計本月維修的料號種類的原因是因為本月不良日報表和上月存量內的所有料號是涵蓋本月維修的料號的
Sub RefreshData()
Dim wb_bl As Workbook '不良品日報表工作簿
Dim wb_wx As Workbook '維修日報表工作簿
Dim sht_me As Worksheet '本報表,即不良品匯總表
Dim sht_wx As Worksheet '維修日報表
Dim sht_bl As Worksheet '不良品日報表
Dim str As String
Set sht_me = ThisWorkbook.ActiveSheet
str = ThisWorkbook.Path
str = Mid(str, 1, InStrRev(str, "\")) '獲取上壹層目錄
Application.ScreenUpdating = False
Set wb_bl = GetObject(str & "不良品日報表" & "\" & Left(ThisWorkbook.Name, 2) & "年不良品統計.xlsm")
Set wb_wx = GetObject(str & "維修日報表" & "\" & Left(ThisWorkbook.Name, 2) & "年維修統計.xlsm")
For Each sht_bl In wb_bl.Sheets '獲取不良品日報表月份
If sht_bl.Name = sht_me.Name Then
Exit For
End If
Next
For Each sht_wx In wb_wx.Sheets '獲取維修日報表月份
If sht_wx.Name = sht_me.Name Then
Exit For
End If
Next
Set d = CreateObject("scripting.dictionary")
Dim cnt_me As Integer
Dim cnt_bl As Integer
Dim cnt_wx As Integer
Dim arr1, x As Integer
arr1 = sht_me.Range("b3:b" & sht_me.Range("b65536").End(xlUp).Row)
For x = 1 To UBound(arr1) '將本表對應月份的料號導入到字典
d(arr1(x, 1)) = x + 1
Next x
arr1 = sht_bl.Range("b3:b" & sht_bl.Range("b65536").End(xlUp).Row)
For x = 1 To UBound(arr1) '將不良品對應月份的料號導入到字典
d(arr1(x, 1)) = x + 1
Next x
'維修統計表的料號不需要導入的原因是,維修的內容必定是基於上月存量和本月不良
sht_me.Range("B3").Resize(d.Count, 1) = Application.WorksheetFunction.Transpose(d.keys)
cnt_me = sht_me.Cells(65535, 2).End(xlUp).Row
cnt_bl = sht_bl.Cells(65535, 2).End(xlUp).Row
cnt_wx = sht_wx.Cells(65535, 2).End(xlUp).Row
For x = 3 To cnt_me
sht_me.Cells(x, 4).Value = Application.WorksheetFunction.SumIf(sht_bl.Range("b3:b" & cnt_bl), sht_me.Cells(x, 2), sht_bl.Range("d3:d" & cnt_bl)) '不良品數量
sht_me.Cells(x, 5).Value = Application.WorksheetFunction.SumIf(sht_wx.Range("b3:b" & cnt_wx), sht_me.Cells(x, 2), sht_wx.Range("c3:c" & cnt_wx)) '維修數量
sht_me.Cells(x, 6).Value = Application.WorksheetFunction.SumIf(sht_wx.Range("b3:b" & cnt_wx), sht_me.Cells(x, 2), sht_wx.Range("d3:d" & cnt_wx)) '報廢數量
Next x
Set d = Nothing
wb_bl.Close False
wb_wx.Close False
Set wb_bl = Nothing
Set wb_wx = Nothing
Application.ScreenUpdating = True
End Sub