123
返回列表 上一主題 發帖

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

luke

帖子
140 
主題
37 
精華
0 
積分
193 
點名
0  
作業系統
Windows XP 
軟體版本
Office 2007 
閱讀權限
20 
註冊時間
2012-3-28 
最後登錄
2015-7-5 

2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-4-21 01:12 | 只看該作者

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

本帖最後由 luke 於 2012-4-21 09:08 編輯

各位大大

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

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

煩請先進 大大指導
TEST13.rar (33.86 KB)
收藏 分享

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2012-4-21 06:16 | 只看該作者
本帖最後由 GBKEE 於 2012-4-21 06:33 編輯

回復 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
複製代碼

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
261  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-10-24 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
3#
發表於 2012-4-21 08:58 | 只看該作者
回復 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
複製代碼
學海無涯_不恥下問

TOP

luke

帖子
140 
主題
37 
精華
0 
積分
193 
點名
0  
作業系統
Windows XP 
軟體版本
Office 2007 
閱讀權限
20 
註冊時間
2012-3-28 
最後登錄
2015-7-5 

2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章
4#
發表於 2012-4-21 11:56 | 只看該作者
回復 2# GBKEE


    謝謝GBKEE 版大

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

     顯示"型態不符合"錯誤

TOP

luke

帖子
140 
主題
37 
精華
0 
積分
193 
點名
0  
作業系統
Windows XP 
軟體版本
Office 2007 
閱讀權限
20 
註冊時間
2012-3-28 
最後登錄
2015-7-5 

2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章
5#
發表於 2012-4-21 11:57 | 只看該作者
回復 3# Hsieh

    謝謝H大

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

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

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
261  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-10-24 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
6#
發表於 2012-4-21 12:41 | 只看該作者
回復 5# luke

無解，sheet2並不分區域，除非在sheet2增加區域欄位
學海無涯_不恥下問

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
7#
發表於 2012-4-21 14:40 | 只看該作者
回復 4# luke
執行5# 的檔案 並沒有錯誤發生

TOP

luke

帖子
140 
主題
37 
精華
0 
積分
193 
點名
0  
作業系統
Windows XP 
軟體版本
Office 2007 
閱讀權限
20 
註冊時間
2012-3-28 
最後登錄
2015-7-5 

2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章
8#
發表於 2012-4-21 15:01 | 只看該作者
回復 6# Hsieh


    謝謝H大

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

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

TOP

luke

帖子
140 
主題
37 
精華
0 
積分
193 
點名
0  
作業系統
Windows XP 
軟體版本
Office 2007 
閱讀權限
20 
註冊時間
2012-3-28 
最後登錄
2015-7-5 

2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章
9#
發表於 2012-4-21 15:22 | 只看該作者
回復 7# GBKEE


    謝謝GBKEE 回覆

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

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
261  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-10-24 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
10#
發表於 2012-4-21 15:33 | 只看該作者
回復 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
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 太陽光大、父母恩大、君子量大，小人氣大。
123
返回列表 上一主題