VBA_兩年度前十進銷貨彙整

兩年度前十進貨及銷貨比較用

 Sub A0_前十進()

'2021/12/16 

Application.ScreenUpdating = False

Dim sh_本期 As Worksheet, sh_目地 As Worksheet, D_工作表, D_資料, D_對象

Set D_工作表 = CreateObject("scripting.dictionary")

Set D_資料 = CreateObject("scripting.dictionary")

Set D_對象 = CreateObject("scripting.dictionary")

'----------------------------------------------------------------------

arr_sh = Array("2021", "2020")

For i = 1 To Sheets.Count

D_工作表(Sheets(i).Name) = Sheets(i).Name

Next

If D_工作表.exists("彙整") = False Then

Sheets.Add.Name = "彙整"

End If

Set sh_目地 = Sheets("彙整")

For i_sh = LBound(arr_sh) To UBound(arr_sh)

With Sheets(arr_sh(i_sh))

lr = .Range("A65536").End(xlUp).Row

in_年度 = arr_sh(i_sh)

For i = 3 To lr

in_科目 = .Cells(i, "B")

in_對象 = .Cells(i, "C")

in_金額 = .Cells(i, "D")

in_趴數 = .Cells(i, "E")

in_品項 = .Cells(i, "F")

D_對象(in_對象) = Array(in_科目, in_對象)

in_條件A = in_年度 & in_對象

D_資料(in_條件A) = Array(in_金額, in_趴數, in_品項)

Next

End With

Next

With sh_目地

.Cells.Delete

.Range("A2").Resize(D_對象.Count, 2) = Application.Transpose(Application.Transpose(D_對象.items)) '有三個資料

.Range("C1").Resize(, 6) = Array("2021", "2020", "2021", "2020", "2021", "2020")

in_年度數 = UBound(arr_sh) + 1

For i = 2 To D_對象.Count + 2

For ic = 0 To 2 '配合字典******************

For c = 3 + ic * in_年度數 To UBound(arr_sh) + 3 + ic * in_年度數 '這裡要注意起始點

'For c = 3 + ic * 2 To UBound(arr_sh) + 3 + ic * 2 '這裡要注意起始點

in_年度 = .Cells(1, c)

in_對象 = .Cells(i, 2)

in_條件 = in_年度 & in_對象

If D_資料.exists(in_條件) = True Then '字典中使用陣列所以必須使用存在檢查******************

.Cells(i, c) = D_資料(in_條件)(ic)

End If

Next

Next

Next

'最後執行攔未修改

.Range("A1").Resize(, 8) = Array("科目代碼", "供應商", "2021金額", "2020金額", "2021比例", "2020比例", "2021項目", "2020項目")

End With

D_資料.RemoveAll

D_對象.RemoveAll

End Sub

Sub A0_前十銷()

'2021/12/16Application.ScreenUpdating = False

Dim sh_本期 As Worksheet, sh_目地 As Worksheet, D_工作表, D_資料, D_對象

Set D_工作表 = CreateObject("scripting.dictionary")

Set D_資料 = CreateObject("scripting.dictionary")

Set D_對象 = CreateObject("scripting.dictionary")

'----------------------------------------------------------------------

arr_sh = Array("2021", "2020")

For i = 1 To Sheets.Count

D_工作表(Sheets(i).Name) = Sheets(i).Name

Next

If D_工作表.exists("彙整") = False Then

Sheets.Add.Name = "彙整"

End If

Set sh_目地 = Sheets("彙整")

For i_sh = LBound(arr_sh) To UBound(arr_sh)

With Sheets(arr_sh(i_sh))

lr = .Range("A65536").End(xlUp).Row

in_年度 = arr_sh(i_sh)

For i = 3 To lr

in_科目 = .Cells(i, "B")

in_對象 = .Cells(i, "C")

in_金額 = .Cells(i, "D")

in_趴數 = .Cells(i, "E")

in_條件 = .Cells(i, "F")

in_品項 = .Cells(i, "G")

D_對象(in_對象) = Array(in_科目, in_對象)

in_條件A = in_年度 & in_對象

D_資料(in_條件A) = Array(in_金額, in_趴數, in_條件, in_品項)

Next

End With

Next

With sh_目地

.Cells.Delete

.Range("A2").Resize(D_對象.Count, 2) = Application.Transpose(Application.Transpose(D_對象.items)) '有三個資料

.Range("C1").Resize(, 8) = Array("2021", "2020", "2021", "2020", "2021", "2020", "2021", "2020")

in_年度數 = UBound(arr_sh) + 1

For i = 2 To D_對象.Count + 2

For ic = 0 To 3 '配合字典******************

For c = 3 + ic * in_年度數 To UBound(arr_sh) + 3 + ic * in_年度數 '這裡要注意起始點

in_年度 = .Cells(1, c)

in_對象 = .Cells(i, 2)

in_條件 = in_年度 & in_對象

If D_資料.exists(in_條件) = True Then '字典中使用陣列所以必須使用存在檢查******************

.Cells(i, c) = D_資料(in_條件)(ic)

End If

Next

Next

Next

'最後執行攔未修改

.Range("A1").Resize(, 10) = Array("科目代碼", "供應商", "2021金額", "2020金額", "2021比例", "2020比例", "2021條件", "2020條件", "2021項目", "2020項目")

End With

D_資料.RemoveAll

D_對象.RemoveAll

End Sub