- 帖子
- 2834
- 主題
- 10
- 精華
- 0
- 積分
- 2890
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-11-22
|
2#
發表於 2015-11-15 18:47
| 只看該作者
Sub TEST()
Dim j&, Jm&, Arr, Brr, xS As Worksheet, xD, N&
Sheets("總和統計表").UsedRange.Offset(1, 0).ClearContents
ReDim Brr(1 To 6000, 1 To 8) '＿陣列預設容納 6000 列，可自行調整
Set xD = CreateObject("Scripting.Dictionary")
For Each xS In Sheets(Array("手寫日報表", "電腦日報表", "進貨表"))
Arr = xS.UsedRange.Offset(1, 0).Value
For j = 1 To UBound(Arr)
Jm = xD(Arr(j, 1)): If Arr(j, 1) = "" Then GoTo 99
If Jm = 0 Then N = N + 1: xD(Arr(j, 1)) = N: Jm = N
Brr(Jm, 1) = Arr(j, 1): Brr(Jm, 2) = Arr(j, 2)
If xS.Name = "進貨表" Then
Brr(Jm, 5) = Brr(Jm, 5) + Arr(j, 4) + Arr(j, 5) '＿總進貨
If InStr(" " & Brr(Jm, 6) & " ", " " & Arr(j, 6) & " ") = 0 Then '＿排除重覆
Brr(Jm, 6) = Trim(Brr(Jm, 6) & " " & Arr(j, 6)) '＿紀念品
End If
Brr(Jm, 8) = Trim(Brr(Jm, 8) & " " & Arr(j, 7)) '＿備註
Else
Brr(Jm, 3) = Brr(Jm, 3) + Arr(j, 4) '＿總張數
Brr(Jm, 4) = Brr(Jm, 4) + Arr(j, 5) '＿總股數
Brr(Jm, 8) = Trim(Brr(Jm, 8) & " " & Arr(j, 6)) '＿備註
End If
Brr(Jm, 7) = Brr(Jm, 5) - Brr(Jm, 3) '＿總進貨-總張數
99: Next
Next
If N = 0 Then Exit Sub
With [總和統計表!A2:H2].Resize(N)
.Value = Brr
.Sort Key1:=.Item(1), Order1:=xlAscending, Header:=xlNo
End With
End Sub
程式碼看起來很多, 其實都只是[參照位置]而已, 請自行去慢慢意會, 不多做說明了~~ |
|
發表於 2015-11-15 15:01
| 
