- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 104
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2025-4-30
               
|
2#
發表於 2019-1-11 15:47
| 只看該作者
本帖最後由 Hsieh 於 2019-1-11 15:58 編輯
是這樣的意思嗎?- Sub 更新日期_Click()
- ActiveObject = Application.Caller '啟動程序的按鈕
- ActiveSheet.Shapes(ActiveObject).TextFrame.Characters.Text = "更新日期:" & Now()
- Call ColorSUM
-
- End Sub
- Public Sub ColorSUM()
- Dim k, i As Integer, Cp(), Dic
- Set Dic = CreateObject("Scripting.Dictionary")
- Cp = Array(3, 13, 33, 4, 9, 22, 27, 1) '色碼
- For i = 0 To UBound(Cp)
- Dic(Cp(i)) = 0
- Next
-
- r = Range("F500").End(xlUp).Offset(3).Row '從特定位置開始加總
-
- For k = 9 To 33
- For i = 17 To Range("C17").End(xlDown).Row '循列計算顏色加總
- Dic(Cells(i, k).Font.ColorIndex) = Dic(Cells(i, k).Font.ColorIndex) + Cells(i, k)
- Next
- For j = 0 To UBound(Cp)
- Cells(r, k).Offset(j).Font.ColorIndex = Cp(j)
- Cells(r, k).Offset(j).Font.Bold = True
- Cells(r, k).Offset(j) = Cells(5, k) + Dic(Cp(j))
- Dic(Cp(j)) = 0 '歸零
- Next
- Next
-
- End Sub
複製代碼 回復 1# JT1221 |
|