给你一个例子,这是我为了解决部分问题而编写的,调试已经通过,其中这些文件放在三个文件夹中,取出来统计到一起,你参考下,有不明白的问我。
'本表的算法分析
'将不良品日报表本月的内容和本月维修汇总表格本月的内容加总,同时将不良品汇总表格上月的存量一起累计出本月的存量
'为了程序的编写方便,不考虑不良品汇总表格的上月内容,实际使用时将其直接从上月拷贝过来使用即可
'这个算法是借用了字典新的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
追问
加我 详细说下 有更多好处的
追答已加