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

我寫了一段小程式主要是依據儲存格的值所屬的區間來產生顏色，但因為有不同的區間值分成好多區塊，每一區的大小不同，分級的數也不同
程式碼概略如下
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)

樓主熱帖

yuch8663

中學生 Rank: 2

帖子: 51
主題: 12
精華: 0
積分: 77
點名: 0
作業系統: windows xp sp3
軟體版本: excel 2003 2007
閱讀權限: 20
註冊時間: 2010-5-4
最後登錄: 2023-10-31

2^#

發表於 2010-8-9 10:16 | 顯示全部帖子

謝謝GBKEE 版主指導，這個迴圈的寫法很高竿，對我來說有點難理解，我試著揣摩揣摩，謝謝。

TOP

yuch8663

中學生 Rank: 2

帖子: 51
主題: 12
精華: 0
積分: 77
點名: 0
作業系統: windows xp sp3
軟體版本: excel 2003 2007
閱讀權限: 20
註冊時間: 2010-5-4
最後登錄: 2023-10-31

3^#

發表於 2010-8-9 10:43 | 顯示全部帖子

剛剛沒注意看luhpro樓主的回覆luhpro 樓主的寫法似乎我比較容易理解，謝謝。

TOP

yuch8663

中學生 Rank: 2

帖子: 51
主題: 12
精華: 0
積分: 77
點名: 0
作業系統: windows xp sp3
軟體版本: excel 2003 2007
閱讀權限: 20
註冊時間: 2010-5-4
最後登錄: 2023-10-31

4^#

發表於 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

yuch8663