12
返回列表 上一主題 發帖

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

yuch8663

帖子
51 
主題
12 
精華
0 
積分
77 
點名
0  
作業系統
windows xp sp3 
軟體版本
excel 2003 2007 
閱讀權限
20 
註冊時間
2010-5-4 
最後登錄
2023-10-31 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2010-8-6 20:09 | 只看該作者

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

我寫了一段小程式主要是依據儲存格的值所屬的區間來產生顏色，但因為有不同的區間值分成好多區塊，每一區的大小不同，分級的數也不同
程式碼概略如下
Sub color()
'第一區----------------------------------------------------------------
    Dim Rng As Range, F As Variant
    For Each F In ThisWorkbook.Sheets("sheet2").[b4:i15]
        
        If F > 800 Then
           F.Interior.ColorIndex = 40
           F.Font.ColorIndex = 3
           F.Font.Bold = True
        ElseIf F > 500 And F <= 800 Then
           F.Interior.ColorIndex = 36
           F.Font.ColorIndex = 3
           F.Font.Bold = True
        ElseIf F > 200 And F <= 500 Then
           F.Interior.ColorIndex = 19
           F.Font.ColorIndex = 3
           F.Font.Bold = True
   
        ElseIf F < -200 And F >= -500 Then
           F.Interior.ColorIndex = 24
           F.Font.ColorIndex = 11
           F.Font.Bold = True
        ElseIf F < -500 And F >= -800 Then
           F.Interior.ColorIndex = 15
           F.Font.ColorIndex = 11
           F.Font.Bold = True
        ElseIf F < -800 Then
           F.Interior.ColorIndex = 48
           F.Font.ColorIndex = 11
           F.Font.Bold = True
        Else
         'F.Interior.ColorIndex = -4142 '無底色

           F.Interior.ColorIndex = 35 '
           F.Font.ColorIndex = 1
           F.Font.Bold = False
        End If
   Next
   
  For Each F In ThisWorkbook.Sheets("sheet2").[j4:l15]
        
        If F > 1600 Then
           F.Interior.ColorIndex = 40
           F.Font.ColorIndex = 3
           F.Font.Bold = True
        ElseIf F > 900 And F <= 1600 Then
           F.Interior.ColorIndex = 36
           F.Font.ColorIndex = 3
           F.Font.Bold = True
        ElseIf F > 400 And F <= 900 Then
           F.Interior.ColorIndex = 19
           F.Font.ColorIndex = 3
           F.Font.Bold = True
   
        ElseIf F < -400 And F >= -900 Then
           F.Interior.ColorIndex = 24
           F.Font.ColorIndex = 11
           F.Font.Bold = True
        ElseIf F < -900 And F >= -1600 Then
           F.Interior.ColorIndex = 15
           F.Font.ColorIndex = 11
           F.Font.Bold = True
        ElseIf F < -1600 Then
           F.Interior.ColorIndex = 48
           F.Font.ColorIndex = 11
           F.Font.Bold = True
        Else
         'F.Interior.ColorIndex = -4142 '無底色

           F.Interior.ColorIndex = 35 '
           F.Font.ColorIndex = 1
           F.Font.Bold = False
        End If
   Next
   ...........
後面還有，但都是重複的寫法，請問要如何縮短程式碼語法? Book1.rar (13.28 KB)
收藏 分享

luhpro

帖子
824 
主題
6 
精華
0 
積分
904 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2023-12-24 
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

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

yuch8663

帖子
51 
主題
12 
精華
0 
積分
77 
點名
0  
作業系統
windows xp sp3 
軟體版本
excel 2003 2007 
閱讀權限
20 
註冊時間
2010-5-4 
最後登錄
2023-10-31 
4#
發表於 2010-8-9 10:16 | 只看該作者
謝謝GBKEE 版主指導，這個迴圈的寫法很高竿，對我來說有點難理解，我試著揣摩揣摩，謝謝。

TOP

yuch8663

帖子
51 
主題
12 
精華
0 
積分
77 
點名
0  
作業系統
windows xp sp3 
軟體版本
excel 2003 2007 
閱讀權限
20 
註冊時間
2010-5-4 
最後登錄
2023-10-31 
5#
發表於 2010-8-9 10:43 | 只看該作者
剛剛沒注意看luhpro樓主的回覆luhpro 樓主的寫法似乎我比較容易理解，謝謝。

TOP

yuch8663

帖子
51 
主題
12 
精華
0 
積分
77 
點名
0  
作業系統
windows xp sp3 
軟體版本
excel 2003 2007 
閱讀權限
20 
註冊時間
2010-5-4 
最後登錄
2023-10-31 
6#
發表於 2010-8-9 11:26 | 只看該作者
回復 5# yuch8663
請問luhpro 樓主，我參研擬的做法將分類標準更改為另一個區塊做參照，會在下列紅字區出現錯誤，請問是何原因?

Sub Color2() 'luhpro 樓主指導
'上述的情形可以利用 Switch 與 Choose 兩個函數來大幅簡化程式,'
'以下僅列出第一小段的程式,其餘僅需變更相關數字後再套用上去即可.

  Dim iRng%, F As Variant

  With ThisWorkbook.Sheets("sheet3")
    For Each F In .Range("b35:p46")
      iRng = Switch(F >= 0.06, 1, F >= 0.04 And F < 0.06, 2, F >= 0.02 And F < 0.04, 3, _
      F > 0 And F < 0.02, 4, F = 0, 5, F < 0 And F > -0.02, 6, _
         , F <= -0.02 And F > -0.04, 7, F <= -0.04 And F > -0.06, 8, F <= -0.06, 9)      F.Offset(-30, 0).Interior.ColorIndex = Choose(iRng, 3, 46, 22, 40, -4142, 15, 43, 50, 10)
      F.Offset(-30, 0).Font.ColorIndex = Choose(iRng, 2, 2, 2, 1, 1, 1, 44, 44, 44)
      F.Offset(-30, 0).Font.Bold = Choose(iRng, True, True, True, False, False, False, True, True, True)
    Next '
  End With

End Sub

Book1.rar (20.33 KB)

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#
發表於 2010-8-9 14:07 | 只看該作者
回復 6# yuch8663

Excel的說明
Switch 函數的引數串列包含多對的運算式和數值，運算式是由左至右加以計算，而數值則會在相聯的運算式為 True 時傳回。如果其中有部份沒有成對，則會產生一個執行中錯誤。如果 expr-1 為 True 則 Switch 傳回 value-1 ，如果 expr-1 為 False，但 expr-2 為 True，則 Switch 傳回 value-2 ，以此類推。
Switch 會傳回一個 Null 值，如果：
沒有一個運算式為 True.
第一個為 True 的運算式，其相對應得值為 Null。
Switch 會計算所有的運算式，雖然它只會傳回其中的一個值，因此您應該留意所產生的副作用，例如，有某個運算式會導致除以零，那麼就會發生錯誤。

TOP

yuch8663

帖子
51 
主題
12 
精華
0 
積分
77 
點名
0  
作業系統
windows xp sp3 
軟體版本
excel 2003 2007 
閱讀權限
20 
註冊時間
2010-5-4 
最後登錄
2023-10-31 
8#
發表於 2010-8-9 15:22 | 只看該作者
謝謝GBKEE版主的解說，但是我不太了解，所謂的運算式是指，F >= 0.06中的"大於"、"等於"、"小於"這些嗎?我檢查過這九組分組並沒有重疊的部分，為何還是有誤?我試過luhpro 樓主的方式在原範例中是可以運行的
魏何增加了二組判斷就不行?

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
9#
發表於 2010-8-9 16:50 | 只看該作者
回復 8# yuch8663
公式太長會看到眼花 多出一個 ,
   iRng = Switch(F >= 0.06, 1, F >= 0.04 And F < 0.06, 2, F >= 0.02 And F < 0.04, 3, _
      F > 0 And F < 0.02, 4, F = 0, 5, F < 0 And F > -0.02, 6, _
        , F <= -0.02 And F > -0.04, 7, F <= -0.04 And F > -0.06, 8, F <= -0.06, 9)

   

TOP

Min
　暱稱: 閔

版主Rank: 7Rank: 7Rank: 7

帖子
172 
主題
39 
精華
20 
積分
177 
點名
0  
作業系統
Microsoft Windows XP 
軟體版本
Microsoft Office 2003 
閱讀權限
100 
性別
男 
來自
高雄 
註冊時間
2010-5-1 
最後登錄
2023-3-19 

論壇貢獻勳章帥哥勳章
10#
發表於 2010-8-9 21:27 | 只看該作者
模組化呢 試試看!

Function SetCellInfo(ByVal fCell As Variant, ByVal iColorIndex As Integer, ByVal fColorIndex As Integer, ByVal fBold As Boolean)
    fCell.Interior.ColorIndex = iColorIndex '
    fCell.Font.ColorIndex = fColorIndex
    fCell.Font.Bold = fBold
End Function

    'Dim Rng As Range 這個變數是多餘的!
    Dim F As Variant
   
    For Each F In ThisWorkbook.Sheets("sheet2").[b4:i15]
        If F > 800 Then
            Call SetCellInfo(F, 40, 3, True)
        ElseIf F > 500 And F <= 800 Then
            Call SetCellInfo(F, 36, 3, True)
        ElseIf F > 200 And F <= 500 Then
            Call SetCellInfo(F, 19, 3, True)
        ElseIf F < -200 And F >= -500 Then
            Call SetCellInfo(F, 24, 11, True)
        ElseIf F < -500 And F >= -800 Then
            Call SetCellInfo(F, 15, 11, True)
        ElseIf F < -800 Then
            Call SetCellInfo(F, 48, 11, True)
        Else
            Call SetCellInfo(F, 35, 1, False)
        End If
    Next F
若是我回答，使您滿意，請您讓我知道！                  
若是我的回覆，您仍有其他見解，也請您不嗇指教！

TOP

        靜思自在 : 一個缺口的杯子，如果換一個角度看它，它仍然是圓的。
12
返回列表 上一主題