[求助] excel VBA多條件求和代碼優化

這種情況用字典法最合適

arr?=?Sheet2.Range("A1:E"?&?Sheet2.[a65536].End(xlUp).Row)?'Sheet2數據存入數組

Set?d1?=?CreateObject("Scripting.Dictionary")?'外發字典

Set?d2?=?CreateObject("Scripting.Dictionary")?'返回字典

Set?d3?=?CreateObject("Scripting.Dictionary")?'生產字典

For?i?=?1?To?UBound(arr)

d1(arr(i,?1)?&?arr(i,?2))?=?d1(arr(i,?1)?&?arr(i,?2))?+?arr(i,?3)

d2(arr(i,?1)?&?arr(i,?2))?=?d1(arr(i,?1)?&?arr(i,?2))?+?arr(i,?4)

d3(arr(i,?1)?&?arr(i,?2))?=?d1(arr(i,?1)?&?arr(i,?2))?+?arr(i,?5)

Next

For?i?=?2?To?[iv3].End(xlToLeft)?Step?4

For?j?=?5?To?[a65536].End(xlUp).Row

Cells(j,?i)?=?d1(Cells(j,?1).Value?&?Cells(3,?i).Value)

Cells(j,?i?+?1)?=?d2(Cells(j,?1).Value?&?Cells(3,?i).Value)

Cells(j,?i?+?3)?=?d3(Cells(j,?1).Value?&?Cells(3,?i).Value)

Next

Next

End?Sub