- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 98
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2024-4-27
              
|
回復 15# wsx24680 - Private Sub CommandButton1_Click()
- Dim A As Range, Rng As Range, B As Range
- Set dc = CreateObject("Scripting.Dictionary")
- Set ds = CreateObject("Scripting.Dictionary")
- With Sheet222
- For Each A In .Range(.[C7], .[C65536].End(xlUp))
- mystr = Mid(A, 5, 3)
- If IsError(Application.Match(mystr, Sheet201.[E10:K10], 0)) Then mystr = "Other"
- Set Rng = .Cells(A.Row, "AM").Resize(, 7)
- If Application.CountA(Rng) > 0 Then Set Rng = Rng.SpecialCells(xlCellTypeConstants) Else GoTo 10
- For Each B In Rng
- m1 = mystr & A.Offset(, 8) & B
- m2 = mystr & B & B.Offset(, 7)
- m3 = mystr & A.Offset(, 8) & .Cells(5, B.Column) & B
- dc(m1) = dc(m1) + 1
- dc(m2) = dc(m2) + 1
- ds(m1) = ds(m1) + B.Offset(, 14)
- ds(m3) = ds(m3) + B.Offset(, 14)
- Next
- 10
- Next
- End With
- With Sheet201
- Set Rng = .Columns("C").SpecialCells(xlCellTypeConstants)
- For Each A In Rng
- If A = "銷售加總數量" Then yn = True
- If InStr(A, "每日銷售數量") > 0 Then mystr1 = Mid(A, 1, 3)
- If A.MergeCells = False Then
- If A.Row < 47 Then
- For Each B In .[E10:K10]
- mystr = B & A & A.Offset(, 1)
- If yn = True Then .Cells(A.Row, B.Column) = ds(mystr) Else .Cells(A.Row, B.Column) = dc(mystr)
- Next
- Else
- For Each B In .[E48:K48]
- mystr = mystr1 & A & B & A.Offset(, 1)
- .Cells(A.Row, B.Column) = ds(mystr)
- Next
- End If
- End If
- Next
- End With
- Set dc = Nothing
- Set ds = Nothing
- MsgBox ("恭喜您~統計完成!!") '結束視窗提示
- End Sub
|
|
發表於 2010-5-18 08:38
| 
