python
复制代码
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