b9208

[attach]790[/attach]
非常感謝前輩指導
程式可以使用。
想增加單位每日銷售數量表單，如ABS, ORO, SHE...。
研究幾天還是無法於前輩程式中增加程式來完成。
功力有待加強（理解力不足）

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

上列程式中，如 Reg 中只有 AM, AP, AR, AS等四欄位有資料（AN. AO, AQ三欄空白），
請問 For Each B In Rng 會執行幾迴圈？

感謝

b9208

抱歉附件沒有上傳成功 C2.rar
C2.rar (17.39 KB)

下載次數: 3

2010-5-21 13:19

Hsieh

回復 11# b9208


    有幾欄資料就執行幾次
勸你還是要遵守資料庫規則製作才能省去麻煩
C2.rar (23.42 KB)

下載次數: 21

2010-5-21 15:07

b9208

Hsieh版主
非常謝謝您
無私分享指導
因資料庫格式是固定的，後方加上的毎日資料，
是為統計分析用的。
謝謝 & 感謝

wsx24680

Hsieh前輩：

由於小弟剛好也在找用Excel VBA多重條件式統計的方法，但這兩天才加入，
所以能否請Hsieh前輩分享一段程式碼來讓小弟參考一下。
感激不盡！

Hsieh

回復 15# wsx24680

1. Private Sub CommandButton1_Click()
   
2. Dim A As Range, Rng As Range, B As Range
   
3. Set dc = CreateObject("Scripting.Dictionary")
   
4. Set ds = CreateObject("Scripting.Dictionary")
   
5. With Sheet222
   
6.    For Each A In .Range(.[C7], .[C65536].End(xlUp))
   
7.        mystr = Mid(A, 5, 3)
   
8.        If IsError(Application.Match(mystr, Sheet201.[E10:K10], 0)) Then mystr = "Other"
   
9.        Set Rng = .Cells(A.Row, "AM").Resize(, 7)
   
10.        If Application.CountA(Rng) > 0 Then Set Rng = Rng.SpecialCells(xlCellTypeConstants) Else GoTo 10
    
11.        For Each B In Rng
    
12.        m1 = mystr & A.Offset(, 8) & B
    
13.        m2 = mystr & B & B.Offset(, 7)
    
14.        m3 = mystr & A.Offset(, 8) & .Cells(5, B.Column) & B
    
15.        dc(m1) = dc(m1) + 1
    
16.        dc(m2) = dc(m2) + 1
    
17.        ds(m1) = ds(m1) + B.Offset(, 14)
    
18.        ds(m3) = ds(m3) + B.Offset(, 14)
    
19.        Next
    
20. 10
    
21.    Next
    
22. End With
    
23. With Sheet201
    
24.    Set Rng = .Columns("C").SpecialCells(xlCellTypeConstants)
    
25.    For Each A In Rng
    
26.    If A = "銷售加總數量" Then yn = True
    
27.    If InStr(A, "每日銷售數量") > 0 Then mystr1 = Mid(A, 1, 3)
    
28.        If A.MergeCells = False Then
    
29.        If A.Row < 47 Then
    
30.           For Each B In .[E10:K10]
    
31.               mystr = B & A & A.Offset(, 1)
    
32.               If yn = True Then .Cells(A.Row, B.Column) = ds(mystr) Else .Cells(A.Row, B.Column) = dc(mystr)
    
33.           Next
    
34.         Else
    
35.           For Each B In .[E48:K48]
    
36.               mystr = mystr1 & A & B & A.Offset(, 1)
    
37.               .Cells(A.Row, B.Column) = ds(mystr)
    
38.           Next
    
39.         End If
    
40.         End If
    
41.     Next
    
42. End With
    
43. Set dc = Nothing
    
44. Set ds = Nothing
    
45. MsgBox ("恭喜您~統計完成!!")   '結束視窗提示
    
46. End Sub

複製代碼

wsx24680

感謝 Hsieh版主的分享，看來b9208大 的資料內容確實有點複雜