返回列表 上一主題 發帖

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

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 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

  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
學海無涯_不恥下問

TOP

        靜思自在 : 地上種了菜，就不易長草；心中有善，就不易生惡。
返回列表 上一主題