- 帖子
- 976
- 主題
- 7
- 精華
- 0
- 積分
- 1018
- 點名
- 0
- 作業系統
- Win10
- 軟體版本
- Office 2016
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2013-4-19
- 最後登錄
- 2026-5-26
|
回復 46# PJChen
請再測試看看,謝謝
Sub test()
Dim Arr, Brr, xD, i&, T$, T1$
Arr = Sheets("南區").Range("a3:k" & [南區!a65536].End(3).Row)
ReDim Brr(1 To UBound(Arr), 1 To 1)
Set xD = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
If Not IsDate(Arr(i, 1)) Then GoTo 98
T = Year(Arr(i, 1)) & "|" & Month(Arr(i, 1))
If i < UBound(Arr) Then T1 = Year(Arr(i, 1)) & "|" & Month(Arr(i + 1, 1)) Else T1 = 0
If xD.Exists(T) Then
If T <> T1 Then
xD(Arr(i, 1)) = Val(xD(T)) + Val(Arr(i, 4))
Brr(i, 1) = xD(Arr(i, 1))
Else
xD(T) = Val(xD(T)) + Val(Arr(i, 4))
End If
Else
xD(T) = Val(Arr(i, 4))
End If
98: Next
Sheets("南區").[i3].Resize(UBound(Brr)) = Brr
End Sub |
|