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 = 3 For i = 0 To UBound( kdicarr) crr = Split( kdicarr( i) , "-" ) wzx. Cells( wzxrow, 1 ) = i + 1 wzx. 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 + 1 Nextwzx. 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 - 1 kdaima = 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:= False ActiveSheet. PasteSet wf = ActiveSheetwf. Name = kdaima & "客户渠道物流返利表模板" wfendrow = wf. Range( "a" & wf. Cells. Rows. Count) . End( xlUp) . Rowwf. Cells( wfendrow + 1 , 1 ) = 1 wf. 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 ) + 1 wf. 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