EXCEL VBA 多个表格的处理和操作汇总

Sub 需求1()fpath = ThisWorkbook.Path & "\"Dim wbdian As WorkbookSet wbdian = Workbooks.Open(fpath & "闪电退税返点比例-zxh更新.xls")Dim wb As WorksheetSet wb = wbdian.Worksheets(1)Dim dicdian As ObjectSet dicdian = CreateObject("scripting.dictionary")For i = 2 To wb.Range("a" & wb.Cells.Rows.Count).End(xlUp).Rowk = wb.Cells(i, "e").Valuepanduan = CDate(Right(wb.Cells(i, "l"), Len(wb.Cells(i, "l")) - InStr(1, wb.Cells(i, "l"), "-")))If Now < panduan ThenIf Not dicdian.exists(k) Thenkitem = wb.Cells(i, "k")dicdian.Add k, kitemEnd IfEnd IfNextwbdian.CloseDim wzx As WorksheetSet wzx = ThisWorkbook.Worksheets("渠道物流返利明细表")wzx.Range("a3:i" & wzx.Cells.Rows.Count).ClearDim wbk As WorkbookSet wbk = Workbooks.Open(fpath & "2024年意大利flash公司库存-2024.3.18.xlsx")Dim dic As ObjectSet dic = CreateObject("scripting.dictionary")Dim dicdate As ObjectSet dicdate = CreateObject("scripting.dictionary")Dim wk As WorksheetSet wk = wbk.Worksheets(1)wkendrow = wk.Range("a" & wk.Cells.Rows.Count).End(xlUp).RowFor i = 3 To wkendrowIf wk.Cells(i, "r") <> "" And Left(wk.Cells(i, "r"), 6) <> wk.Cells(i, 2) Thenk1 = wk.Cells(i, 2)k2 = wk.Cells(i, "o")k3 = wk.Cells(i, "r")kitem = wk.Cells(i, "M").Valuekdate = wk.Cells(i, "p")If Not dicdate.exists(k2) Thendicdate.Add k2, kdateEnd Ifk = k1 & "-" & k2 & "-" & k3If Not dic.exists(k) Thendic.Add k, kitemElsedic(k) = dic(k) + kitemEnd IfEnd IfNextwbk.Closekdicarr = dic.keys()kdicbrr = dic.items()wzxrow = 3For i = 0 To UBound(kdicarr)crr = Split(kdicarr(i), "-")wzx.Cells(wzxrow, 1) = i + 1wzx.Cells(wzxrow, 2) = crr(2)wzx.Cells(wzxrow, 3) = crr(0)wzx.Cells(wzxrow, 5) = crr(1)wzx.Cells(wzxrow, 6) = kdicbrr(i)wzx.Cells(wzxrow, 4) = dicdate(crr(1))wzx.Cells(wzxrow, 7) = dicdian(crr(2))If Month(wzx.Cells(wzxrow, 4)) >= 1 And Month(wzx.Cells(wzxrow, 4)) <= 3 Thenwzx.Cells(wzxrow, 9) = Year(wzx.Cells(wzxrow, 4)) & "年第" & 1 & "季度"ElseIf Month(wzx.Cells(wzxrow, 4)) >= 4 And Month(wzx.Cells(wzxrow, 4)) <= 6 Thenwzx.Cells(wzxrow, 9) = Year(wzx.Cells(wzxrow, 4)) & "年第" & 2 & "季度"ElseIf Month(wzx.Cells(wzxrow, 4)) >= 7 And Month(wzx.Cells(wzxrow, 4)) <= 9 Thenwzx.Cells(wzxrow, 9) = Year(wzx.Cells(wzxrow, 4)) & "年第" & 3 & "季度"Elsewzx.Cells(wzxrow, 9) = Year(wzx.Cells(wzxrow, 4)) & "年第" & 4 & "季度"End Ifwzx.Cells(wzxrow, 8).FormulaR1C1 = "=RC[-2]*RC[-1]"wzx.Cells(wzxrow, 8).NumberFormatLocal = "#,##0.00 ""€"";-#,##0.00 ""€"""wzxrow = wzxrow + 1Nextwzx.Cells(wzxrow, 1) = "合计"wzx.Cells(wzxrow, "f") = Application.WorksheetFunction.Sum(wzx.Range("f3:f" & wzxrow - 1))wzx.Cells(wzxrow, "h") = Application.WorksheetFunction.Sum(wzx.Range("h3:h" & wzxrow - 1))wzx.Cells(wzxrow, "f").NumberFormatLocal = "#,##0.00 ""€"";-#,##0.00 ""€"""wzx.Cells(wzxrow, "h").NumberFormatLocal = "#,##0.00 ""€"";-#,##0.00 ""€"""End SubSub 拆分()Dim dic As ObjectSet dic = CreateObject("scripting.dictionary")Dim wzx As WorksheetSet wzx = ThisWorkbook.Worksheets("渠道物流返利明细表")Dim wf As WorksheetFor i = 3 To wzx.Range("a" & wzx.Cells.Rows.Count).End(xlUp).Row - 1kdaima = wzx.Cells(i, 2)If Not dic.exists(kdaima) Thendic.Add kdaima, ""ThisWorkbook.Worksheets("xxx客户渠道物流返利表模板").Range("a1:i2").CopySheets.Add After:=ActiveSheetSelection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _SkipBlanks:=False, Transpose:=FalseActiveSheet.PasteSet wf = ActiveSheetwf.Name = kdaima & "客户渠道物流返利表模板"wfendrow = wf.Range("a" & wf.Cells.Rows.Count).End(xlUp).Rowwf.Cells(wfendrow + 1, 1) = 1wf.Cells(wfendrow + 1, 2) = wzx.Cells(i, 2)wf.Cells(wfendrow + 1, 3) = wzx.Cells(i, 5)wf.Cells(wfendrow + 1, 4) = wzx.Cells(i, 4)wf.Cells(wfendrow + 1, 5) = wzx.Cells(i, 6)wf.Cells(wfendrow + 1, 6) = wzx.Cells(i, 7)wf.Cells(wfendrow + 1, 7) = wzx.Cells(i, 8)wf.Cells(wfendrow + 1, 8) = wzx.Cells(i, 9)wf.Cells(wfendrow + 1, 9) = wzx.Cells(i, 3)wf.Cells(1, 1) = kdaima & "-" & Year(wf.Cells(1, 4)) & "年渠道物流返利明细表"ElseSet wf = Worksheets(kdaima & "客户渠道物流返利表模板")wfendrow = wf.Range("a" & wf.Cells.Rows.Count).End(xlUp).Rowwf.Cells(wfendrow + 1, 1) = wf.Cells(wfendrow, 1) + 1wf.Cells(wfendrow + 1, 2) = wzx.Cells(i, 2)wf.Cells(wfendrow + 1, 3) = wzx.Cells(i, 5)wf.Cells(wfendrow + 1, 4) = wzx.Cells(i, 4)wf.Cells(wfendrow + 1, 5) = wzx.Cells(i, 6)wf.Cells(wfendrow + 1, 6) = wzx.Cells(i, 7)wf.Cells(wfendrow + 1, 7) = wzx.Cells(i, 8)wf.Cells(wfendrow + 1, 8) = wzx.Cells(i, 9)wf.Cells(wfendrow + 1, 9) = wzx.Cells(i, 3)End IfNext
End Sub