帖子: 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)

樓主熱帖

Min

　暱稱: 閔

版主 Rank: 7 Rank: 7 Rank: 7

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

論壇貢獻勳章帥哥勳章

12^#

發表於 2010-8-10 13:16 | 只看該作者

GBKEE版主感恩哪，我還真沒看出那一點，若不是切割程式行自己應該可以發現的到。
閔版主的模組化設計也是堪 ...
yuch8663 發表於 2010/8/9 10:04 PM

您可以用F8逐步跑跑看有問題再上來問~

Book1.zip (12.93 KB)

若是我回答，使您滿意，請您讓我知道！
若是我的回覆，您仍有其他見解，也請您不嗇指教！

TOP

yuch8663

中學生 Rank: 2

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

11^#

發表於 2010-8-9 22:04 | 只看該作者

GBKEE版主感恩哪，我還真沒看出那一點，若不是切割程式行自己應該可以發現的到。
閔版主的模組化設計也是堪稱一流，不過我不太容易理解，還不曉得該如何套用，但是都很感恩各位版主的指導，謝謝。

TOP

Min

　暱稱: 閔

版主 Rank: 7 Rank: 7 Rank: 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

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 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

yuch8663

中學生 Rank: 2

帖子: 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

超級版主 Rank: 8 Rank: 8

帖子: 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

中學生 Rank: 2

帖子: 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

yuch8663