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

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



1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145