[發問] 如何利用核取方塊做數量加總計算

luke

各位大大

小第想利用sheet1表4個核取方塊作選單選擇, 當代碼A01-D01小方塊有被勾選,

該代碼全部所對應區域的料號顯示數量要與sheet2表相同料號的數量做加總計算.

煩請先進 大大指導
TEST13.rar (33.86 KB)

下載次數: 13

2012-4-21 01:12

GBKEE

回復 1# luke
將所有的核取方塊 指定巨集 為此程序

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim D As Object, 區域 As String, E, Check As Object
   
4.     Set D = CreateObject("Scripting.Dictionary")
   
5.     With sheet1
   
6.         Set Check = ActiveSheet.Shapes(Application.Caller).OLEFormat.Object '選取的 核取方塊
   
7.         區域 = Check.Caption                                                '核取方塊的標題文字
   
8.         For Each E In .Range("A9").CurrentRegion.Columns(1).Cells
   
9.                 If E = 區域 Then D(E.Cells(1, 2) & E.Cells(1, 3)) = E.Cells(1, 4)
   
10.         Next
    
11.     End With
    
12.     With sheet2
    
13.         For Each E In .Range("A1").CurrentRegion.Columns(1).Cells
    
14.             If Check.Value=1 Then
    
15.                 If D(E & E.Cells(1, 2)) <> "" Then E.Cells(1, 4) = D(E & E.Cells(1, 2)) + E.Cells(1, 3)
    
16.             Else
    
17.                 If D(E & E.Cells(1, 2)) <> "" Then E.Cells(1, 4) = E.Cells(1, 3)
    
18.             End If
    
19.         Next
    
20.     End With
    
21. End Sub

複製代碼

Hsieh

回復 1# luke
按鈕執行此程式

1. Sub ex()
   
2. Dim sp As Shape, A As Range
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. With sheet1
   
5. For Each sp In .Shapes
   
6. If sp.Name Like "Check*" Then
   
7.   If sp.OLEFormat.Object.Value = 1 Then d(sp.OLEFormat.Object.Caption) = 0
   
8. End If
   
9. Next
   
10. For Each A In .Range(.[A10], .[A10].End(xlDown))
    
11. If d.exists(A.Value) = True Then d(A.Offset(, 1) & A.Offset(, 2)) = A.Offset(, 3)
    
12. Next
    
13. End With
    
14. With sheet2
    
15. For Each A In .Range(.[A2], .[A2].End(xlDown))
    
16. A.Offset(, 3) = A.Offset(, 2) + d(A & A.Offset(, 1))
    
17. Next
    
18. End With
    
19. End Sub

複製代碼

luke

回復 2# GBKEE


    謝謝GBKEE 版大

     執行至第7列
     區域 = Check.Caption

     顯示"型態不符合"錯誤

luke

回復 3# Hsieh

    謝謝H大

    若A01-D01代碼顯示區域有相同的料號時,
    應如何避免相加的錯誤如黃色資料列所示

     煩請先進 大大指導
    TEST13A.rar (24.48 KB)

下載次數: 8

2012-4-21 11:57

Hsieh

回復 5# luke

無解，sheet2並不分區域，除非在sheet2增加區域欄位

GBKEE

回復 4# luke
執行5# 的檔案 並沒有錯誤發生

luke

回復 6# Hsieh


    謝謝H大

    如sheet1表E欄給了判斷, 再將勾選後的結果
    整理至sheet1表G:I欄如修正數量所示
   
     請問如何與sheet2表相對應的料號做加總

      煩請先進 大大指導
       TEST13B.rar (24.53 KB)

下載次數: 7

2012-4-21 15:01

luke

回復 7# GBKEE


    謝謝GBKEE 回覆

     F8逐步執行後顯示"型態不符合"錯誤
     

下載 (130.96 KB)

2012-4-21 15:20

Hsieh

回復 8# luke

1. Sub ex()
   
2. Dim sp As Shape, A As Range
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. With sheet1
   
5. For Each sp In .Shapes
   
6. If sp.Name Like "Check*" Then
   
7.   If sp.OLEFormat.Object.Value = 1 Then d(sp.OLEFormat.Object.Caption) = 0
   
8. End If
   
9. Next
   
10. For Each A In .Range(.[A10], .[A10].End(xlDown))
    
11. If d.exists(A.Value) = True Then d(A.Offset(, 1) & A.Offset(, 2)) = d(A.Offset(, 1) & A.Offset(, 2)) + A.Offset(, 3)
    
12. Next
    
13. End With
    
14. With sheet2
    
15. For Each A In .Range(.[A2], .[A2].End(xlDown))
    
16. A.Offset(, 4) = A.Offset(, 2) + d(A & A.Offset(, 1))
    
17. Next
    
18. End With
    
19. End Sub

複製代碼