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

Sub 需求1()
    fpath = ThisWorkbook.Path & "\"
    

    Dim wbdian As Workbook
    Set wbdian = Workbooks.Open(fpath & "闪电退税返点比例-zxh更新.xls")
    Dim wb As Worksheet
    Set wb = wbdian.Worksheets(1)
    Dim dicdian As Object
    Set dicdian = CreateObject("scripting.dictionary")
    For i = 2 To wb.Range("a" & wb.Cells.Rows.Count).End(xlUp).Row
        k = wb.Cells(i, "e").Value
        panduan = CDate(Right(wb.Cells(i, "l"), Len(wb.Cells(i, "l")) - InStr(1, wb.Cells(i, "l"), "-")))
        If Now < panduan Then
            If Not dicdian.exists(k) Then
                kitem = wb.Cells(i, "k")
                dicdian.Add k, kitem
            End If
        End If
    Next
    wbdian.Close
    

    Dim wzx As Worksheet
    Set wzx = ThisWorkbook.Worksheets("渠道物流返利明细表")
    wzx.Range("a3:i" & wzx.Cells.Rows.Count).Clear
    Dim wbk As Workbook
    Set wbk = Workbooks.Open(fpath & "2024年意大利flash公司库存-2024.3.18.xlsx")
    Dim dic As Object
    Set dic = CreateObject("scripting.dictionary")
    Dim dicdate As Object
    Set dicdate = CreateObject("scripting.dictionary")
    Dim wk As Worksheet
    Set wk = wbk.Worksheets(1)
    wkendrow = wk.Range("a" & wk.Cells.Rows.Count).End(xlUp).Row
    For i = 3 To wkendrow
        If wk.Cells(i, "r") <> "" And Left(wk.Cells(i, "r"), 6) <> wk.Cells(i, 2) Then
            k1 = wk.Cells(i, 2)
            k2 = wk.Cells(i, "o")
            k3 = wk.Cells(i, "r")
            kitem = wk.Cells(i, "M").Value
            kdate = wk.Cells(i, "p")
            
            If Not dicdate.exists(k2) Then
                dicdate.Add k2, kdate
            End If
            
            k = k1 & "-" & k2 & "-" & k3
            If Not dic.exists(k) Then
                dic.Add k, kitem
            Else
                dic(k) = dic(k) + kitem
            End If
        End If
    Next
    
    wbk.Close
    
    
    
    kdicarr = 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 Then
            wzx.Cells(wzxrow, 9) = Year(wzx.Cells(wzxrow, 4)) & "年第" & 1 & "季度"
        ElseIf Month(wzx.Cells(wzxrow, 4)) >= 4 And Month(wzx.Cells(wzxrow, 4)) <= 6 Then
            wzx.Cells(wzxrow, 9) = Year(wzx.Cells(wzxrow, 4)) & "年第" & 2 & "季度"
        ElseIf Month(wzx.Cells(wzxrow, 4)) >= 7 And Month(wzx.Cells(wzxrow, 4)) <= 9 Then
            wzx.Cells(wzxrow, 9) = Year(wzx.Cells(wzxrow, 4)) & "年第" & 3 & "季度"
        Else
            wzx.Cells(wzxrow, 9) = Year(wzx.Cells(wzxrow, 4)) & "年第" & 4 & "季度"
        End If
        wzx.Cells(wzxrow, 8).FormulaR1C1 = "=RC[-2]*RC[-1]"
        wzx.Cells(wzxrow, 8).NumberFormatLocal = "#,##0.00 ""€"";-#,##0.00 ""€"""
        
        
        wzxrow = wzxrow + 1
    Next

    wzx.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 Sub

Sub 拆分()
    Dim dic As Object
    Set dic = CreateObject("scripting.dictionary")
    Dim wzx As Worksheet
    Set wzx = ThisWorkbook.Worksheets("渠道物流返利明细表")
    Dim wf As Worksheet
    
    For i = 3 To wzx.Range("a" & wzx.Cells.Rows.Count).End(xlUp).Row - 1
        kdaima = wzx.Cells(i, 2)
        If Not dic.exists(kdaima) Then
            dic.Add kdaima, ""
            ThisWorkbook.Worksheets("xxx客户渠道物流返利表模板").Range("a1:i2").Copy
                Sheets.Add After:=ActiveSheet
                Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
                    SkipBlanks:=False, Transpose:=False
                ActiveSheet.Paste
                
                Set wf = ActiveSheet
                wf.Name = kdaima & "客户渠道物流返利表模板"
                wfendrow = wf.Range("a" & wf.Cells.Rows.Count).End(xlUp).Row
                wf.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)) & "年渠道物流返利明细表"
        Else
                Set wf = Worksheets(kdaima & "客户渠道物流返利表模板")
                wfendrow = wf.Range("a" & wf.Cells.Rows.Count).End(xlUp).Row
                wf.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 If
    Next
End Sub