- 帖子
- 13
- 主題
- 3
- 精華
- 0
- 積分
- 22
- 點名
- 0
- 作業系統
- WIN 7
- 軟體版本
- office 2010
- 閱讀權限
- 10
- 性別
- 男
- 註冊時間
- 2011-8-25
- 最後登錄
- 2011-9-15
|
7#
發表於 2011-8-31 13:29
| 只看該作者
回復 5# Hsieh
Sub Last_month()
Dim A As Range
Dim TheDate As Date
Set d = CreateObject("Scripting.Dictionary")
TheDate = Date
diff = DatePart("w", TheDate, vbUseSystem)
rr = DateAdd("d", (diff - 35), TheDate)
wb = Format(rr, "mmdd")
tt = Format(rr, "mm")
With Workbooks.Open(ThisWorkbook.Path & "\100" + tt & "\" & "NOC" + wb & ".xls")
With .Sheets(1)
For Each A In .Range(.[I2], .[I2].End(xlDown))
If IsEmpty(d(A.Value)) Then
d(A.Value) = Array(1, A.Offset(, 7).Value)
Else
ar = d(A.Value)
ar(0) = ar(0) + 1
ar(1) = ar(1) + A.Offset(, 7).Value
d(A.Value) = ar
End If
Next
End With
.Close
End With
With Sheet1
For i = 5 To .[B65536].End(xlUp).Row Step 2
Set A = .Cells(i, 2)
A.Offset(, 4).Resize(2, 1) = Application.Transpose(d(A.Value))
Next
.Range("f19").Formula = "=f5+f7+f9+f11+f13+f15+f17"
.Range("f20").Formula = "=f6+f8+f10+f12+f14+f16+f18"
.Range("f45").Formula = "=f21+f33+f35+f37+f39+f41+f43"
.Range("f46").Formula = "=f22+f34+f36+f38+f40+f42+f44"
.Range("f47").Formula = "=f19+f45+f23+f25+f27+f29+f31"
.Range("f48").Formula = "=f20+f46+f24+f26+f28+f30+f32"
End With
End Sub
----------------------------------------------
大哥:
目前是可以抓取上個月同一日的檔案,若遇假日或六日要往前推前一個工作日,要如何改?例如:7/31是星期日,要抓7/29,或是9/12中秋節,則要抓9/9檔案資料,拜託!! |
|