12
返回列表 上一主題 發帖

請問依儲存格數值條件顯示文字及背景色的問題

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
3# 跳轉到 »
發表於 2010-8-7 07:29 | 只看該作者
回復 1# yuch8663
試試看
  1. Sub Color()
  2.    '示範到第三區----------------------------------------------------------------
  3.    Dim 區域 As Range, Ar1, Ar2, Ar3, 值, 底色, 字色, i%
  4.    Set 區域 = ThisWorkbook.Sheets("sheet2").[b4:i15,j4:l15,m4:n15]
  5.    '區域是各區的位置 請修改
  6.    Ar1 = Array(Array(800, 500, 200), Array(1600, 900, 400), Array(4000, 2500, 1000))
  7.    'Ar1 陣列 依序對應到是各區塊的值
  8.    Ar2 = Array(Array(40, 36, 19, 24, 15, 48, 35), Array(40, 36, 19, 24, 15, 48, 35), Array(3, 22, 40, 43, 50, 10, 39))
  9.    'Ar2 陣列 依序對應到是各區塊 If 所判斷的底色的索引值
  10.    Ar3 = Array(Array(3, 11, 1), Array(3, 11, 1), Array(6, 3, 1))
  11.    'Ar3 陣列 依序對應到是各區塊 If 所判斷的字體顏色的索引值
  12.     For i = 0 To 區域.Areas.Count - 1   '依序在 區域的各區塊
  13.         For Each F In 區域.Areas(i + 1).Cells  '依序在 區塊的每一個 Cell
  14.             值 = Ar1(i): 底色 = Ar2(i): 字色 = Ar3(i)   '取得區塊所對應到的陣列
  15.             F.Font.Bold = True
  16.             If F > 值(0) Then
  17.                 F.Interior.ColorIndex = 底色(0)
  18.                 F.Font.ColorIndex = 字色(0)
  19.             ElseIf F > 值(1) And F <= 值(0) Then
  20.                 F.Interior.ColorIndex = 底色(1)
  21.                 F.Font.ColorIndex = 字色(0)
  22.             ElseIf F > 值(2) And F <= 值(1) Then
  23.                 F.Interior.ColorIndex = 底色(2)
  24.                 F.Font.ColorIndex = 字色(0)
  25.             ElseIf F < -值(2) And F >= -值(1) Then
  26.                 F.Interior.ColorIndex = 底色(3)
  27.                 F.Font.ColorIndex = 字色(1)
  28.             ElseIf F < -值(1) And F >= -值(0) Then
  29.                 F.Interior.ColorIndex = 底色(4)
  30.                 F.Font.ColorIndex = 字色(1)
  31.             ElseIf F < -值(0) Then
  32.                 F.Interior.ColorIndex = 底色(5)
  33.                 F.Font.ColorIndex = 字色(1)
  34.             Else
  35.                 F.Interior.ColorIndex = 底色(6)
  36.                 F.Font.ColorIndex = 字色(2)
  37.                 F.Font.Bold = False
  38.             End If
  39.         Next
  40.     Next
  41. End Sub
複製代碼

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2025-7-5 
2#
發表於 2010-8-7 00:44 | 只看該作者
上述的情形可以利用 Switch 與 Choose 兩個函數來大幅簡化程式,
以下僅列出第一小段的程式,其餘僅需變更相關數字後再套用上去即可.

  Dim iRng%, F As Variant

  With ThisWorkbook.Sheets("sheet2")
    For Each F In .Range("b4:i15")
      iRng = Switch(F > 800, 1, F > 500 And F <= 800, 2, F > 200 And F <= 500, 3, F >= -200 And F <= 200, 4 _
         , F < -200 And F >= -500, 5, F < -500 And F >= -800, 6, F < -800, 7)
      F.Interior.ColorIndex = Choose(iRng, 40, 36, 19, 35, 24, 15, 48)
      F.Font.ColorIndex = Choose(iRng, 3, 3, 3, 1, 11, 11, 11)
      F.Font.Bold = Choose(iRng, True, True, True, False, True, True, True)
    Next

    For Each F In .Range("j4:l15")
    .
    .
    .
    Next

    .
    .
    .

  End With

TOP

        靜思自在 : 甘願做、歡喜受。
12
返回列表 上一主題