Public Sub NextSeven_CodeFrame()Application.ScreenUpdating = FalseApplication.DisplayAlerts = FalseApplication.Calculation = xlCalculationManualApplication.StatusBar = ">>>>>>>>程序正在运行>>>>>>>>"On Error GoTo ErrHandlerDim StartTime, UsedTime As VariantStartTime = VBA.Timer'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>Dim Wb As WorkbookDim Sht As WorksheetDim OpenWb As WorkbookDim OneSht As WorksheetDim Arr As VariantDim i As LongDim FolderPath As StringDim FileName As StringDim FileCount As LongDim OneKeyDim Key As StringDim Dic As ObjectSet Dic = CreateObject("Scripting.Dictionary")'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>Set Wb = Application.ThisWorkbookSet Sht = Wb.Worksheets("分类汇总")FolderPath = Wb.Path & Application.PathSeparatorFileCount = 0FileName = Dir(FolderPath & "*.xls*")Do While FileName <> ""If FileName <> ThisWorkbook.Name ThenFileCount = FileCount + 1Set OpenWb = Application.Workbooks.Open(FolderPath & FileName)With OpenWbFor Each OneSht In .WorksheetsIf OneSht.Name Like "*月" ThenWith OneShtendrow = .Cells(.Cells.Rows.Count, "B").End(xlUp).RowSet Rng = .Range("A3:F" & endrow)Arr = Rng.ValueFor i = LBound(Arr) To UBound(Arr)Key = .Name & ";" & CStr(Arr(i, 2) & ";" & Arr(i, 3))Dic(Key) = Dic(Key) + Arr(i, 4)Next iEnd WithEnd IfNext OneSht.Close FalseEnd WithEnd IfFileName = DirLoopWith Sht.Cells.Clear.Range("A1:D1").Value = Array("月份", "型号与品名", "工序", "总数")i = 1For Each OneKey In Dic.Keysi = i + 1Key = CStr(OneKey).Cells(i, 1).Value = Split(Key, ";")(0).Cells(i, 2).Value = Split(Key, ";")(1).Cells(i, 3).Value = Split(Key, ";")(2).Cells(i, 4).Value = Dic(OneKey)Next OneKeySetEdges .UsedRangeEnd With'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>UsedTime = VBA.Timer - StartTimeMsgBox "本次耗时：" & Format(UsedTime, "0.000秒"), vbOKOnly, "Tips"ErrorExit:Set Wb = NothingSet Sht = NothingSet OpenWb = NothingSet OneSht = NothingSet Rng = NothingApplication.ScreenUpdating = TrueApplication.DisplayAlerts = TrueApplication.Calculation = xlCalculationAutomaticApplication.StatusBar = FalseExit Sub'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
ErrHandler:If Err.Number <> 0 ThenMsgBox Err.Description & "！", vbCritical, "Tips"'Debug.Print Err.DescriptionErr.ClearResume ErrorExitEnd If
End Sub