VBA_彙整多期BS及IS資料

彙整多期BS及IS資料

 Sub A0_BS多年度科目比較()

'2021/12/15 

Application.ScreenUpdating = False

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

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

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

Set D_科目 = CreateObject("scripting.dictionary")

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

arr_sh = Array("202101", "202102", "202103", "202104", "202105", "202106", "202107", "202108", "202109")

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("A1048576").End(xlUp).Row

in_月份 = arr_sh(i_sh)

For i = 6 To lr

If .Cells(i, "B") <> "" And .Cells(i, "B") <> 0 Then

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

in_餘額A = .Cells(i, "B")

D_科目(in_科目A) = in_科目A

in_條件A = in_月份 & in_科目A

D_資料(in_條件A) = in_餘額A

End If

Next

For i = 6 To lr

If .Cells(i, "E") <> "" And .Cells(i, "E") <> 0 Then

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

in_餘額B = .Cells(i, "E")

D_科目(in_科目B) = in_科目B

in_條件B = in_月份 & in_科目B

D_資料(in_條件B) = in_餘額B

End If

Next

End With

Next

With sh_目地

.Cells.Delete

.Range("B1").Resize(, UBound(arr_sh) + 1) = arr_sh

.Range("A2").Resize(D_科目.Count, 1) = Application.Transpose(D_科目.keys)

For c = 2 To UBound(arr_sh) + 2

in_月份 = .Cells(1, c)

For i = 2 To D_科目.Count + 2

in_科目 = .Cells(i, 1)

in_條件 = in_月份 & in_科目

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

Next

Next

End With

D_資料.RemoveAll

D_科目.RemoveAll

End Sub

Sub A0_IS多年度科目比較()

'2021/12/15 

Application.ScreenUpdating = False

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

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

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

Set D_科目 = CreateObject("scripting.dictionary")

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

arr_sh = Array("202101", "202102", "202103", "202104", "202105", "202106", "202107", "202108", "202109")

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("A1048576").End(xlUp).Row

in_月份 = arr_sh(i_sh)

For i = 5 To lr

If .Cells(i, "B") <> "" And .Cells(i, "B") <> 0 Then

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

in_餘額A = .Cells(i, "B")

D_科目(in_科目A) = in_科目A

in_條件A = in_月份 & in_科目A

D_資料(in_條件A) = in_餘額A

End If

Next

End With

Next

With sh_目地

.Cells.Delete

.Range("B1").Resize(, UBound(arr_sh) + 1) = arr_sh

.Range("A2").Resize(D_科目.Count, 1) = Application.Transpose(D_科目.keys)

For c = 2 To UBound(arr_sh) + 2

in_月份 = .Cells(1, c)

For i = 2 To D_科目.Count + 2

in_科目 = .Cells(i, 1)

in_條件 = in_月份 & in_科目

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

Next

Next

End With

D_資料.RemoveAll

D_科目.RemoveAll

End Sub