標題: [發問] 針對 (特定範圍內) 字體顏色自動計算加總與按鈕更新問題 [打印本頁]

---

作者: JT1221    時間: 2019-1-11 14:22     標題: 針對 (特定範圍內) 字體顏色自動計算加總與按鈕更新問題

各位版大好

遇到一個問題和寫法請各先進指導 !! 先感謝大家~~

問題：按鈕換頁後，VBA因為按鈕代號不同，無法執行，是否有通用的寫法可以在更換下一個工作頁時會自動偵測按鈕代號

附件是『針對每個月需計算庫存與接單後剩餘的數量自己寫的簡易VBA，想請教先進是否有其他方式能簡化程式碼 (最下面顏色設定如果有10個就會寫不完了):L ，謝謝

[attach]29936[/attach]

---

作者: Hsieh    時間: 2019-1-11 15:47

本帖最後由 Hsieh 於 2019-1-11 15:58 編輯

是這樣的意思嗎?

1. Sub 更新日期_Click()
   
2.     ActiveObject = Application.Caller '啟動程序的按鈕
   
3.     ActiveSheet.Shapes(ActiveObject).TextFrame.Characters.Text = "更新日期：" & Now()
   
4.     Call ColorSUM
   
5.    
   
6. End Sub
   
7. 
   
8. Public Sub ColorSUM()
   
9.     Dim k, i As Integer, Cp(), Dic
   
10.     Set Dic = CreateObject("Scripting.Dictionary")
    
11.     Cp = Array(3, 13, 33, 4, 9, 22, 27, 1) '色碼
    
12.     For i = 0 To UBound(Cp)
    
13.        Dic(Cp(i)) = 0
    
14.     Next
    
15.    
    
16.    r = Range("F500").End(xlUp).Offset(3).Row '從特定位置開始加總
    
17.    
    
18.     For k = 9 To 33
    
19.         For i = 17 To Range("C17").End(xlDown).Row '循列計算顏色加總
    
20.           Dic(Cells(i, k).Font.ColorIndex) = Dic(Cells(i, k).Font.ColorIndex) + Cells(i, k)
    
21.         Next
    
22.         For j = 0 To UBound(Cp)
    
23.            Cells(r, k).Offset(j).Font.ColorIndex = Cp(j)
    
24.            Cells(r, k).Offset(j).Font.Bold = True
    
25.            Cells(r, k).Offset(j) = Cells(5, k) + Dic(Cp(j))
    
26.            Dic(Cp(j)) = 0 '歸零
    
27.         Next
    
28.     Next
    
29.    
    
30. End Sub

複製代碼

回復 1# JT1221

---

作者: JT1221    時間: 2019-1-11 16:37

回復 2# Hsieh

感謝Hsieh超級版主的回覆，你寫的程式碼超級精簡，正在研究中 !!   {:3_59:}

試執行之後，按鈕的部份沒問題，但是下面計算結果有點問題，應該是我原來的說明不清楚造成。
我做了一張圖來說明計算的規則
最上面1的部份是現在庫存，中間的區塊不理會
2的部份是客戶需求，目前裡面都是【-值】，所以會直接用+號來做計算
3的部份是我需要計算的目前剩餘庫存，目前依1的部份來說，應該會有三種顏色，但實際執行有四種顏色 !!
因為程式碼還看不太懂，所以要麻煩再幫忙看看 !!  感謝 !!

[attach]29937[/attach]
[attach]29938[/attach]

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)