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

yuch8663

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

下載次數: 14

2010-8-6 20:09

Min

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

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

yuch8663

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

Min

模組化呢 試試看!

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

GBKEE

回復 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)

   

yuch8663

謝謝GBKEE版主的解說，但是我不太了解，所謂的運算式是指，F >= 0.06中的"大於"、"等於"、"小於"這些嗎?我檢查過這九組分組並沒有重疊的部分，為何還是有誤?我試過luhpro 樓主的方式在原範例中是可以運行的
魏何增加了二組判斷就不行?

GBKEE

回復 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 會計算所有的運算式，雖然它只會傳回其中的一個值，因此您應該留意所產生的副作用，例如，有某個運算式會導致除以零，那麼就會發生錯誤。

yuch8663

回復 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)

下載次數: 9

2010-8-9 11:25

yuch8663

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

yuch8663

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