2

ここで見つけた別の質問に基づいて、Select Case ループをモデル化しました(リンク: Excel VBA Select Case Loop Sub )。

適用可能にするために私がしなければならなかった変更はごくわずかで、どこが間違っていたのかわかりません。これが私のコードです：

Private Function getColor(ByVal MatVal As Range) As Integer
        Select Case MatVal
            Case 0 To 1
                getColor = 9: Exit Function
            Case 1.01 To 3
                getColor = 46: Exit Function
            Case 3.01 To 5
                getColor = 27: Exit Function
            Case 5.01 To 10
                getColor = 4: Exit Function
            Case 10.01 To 20
                getColor = 5: Exit Function
            Case 20.01 To 30
                getColor = 11: Exit Function
            Case 30 To 100
                getColor = 29: Exit Function
        End Select
End Function

これは次の方法で呼び出されます：

Set LipR = Workbooks("LMacro.xlsm")
Set SecX = Application.Workbooks.Open(Path & "SecX.csv")
Set Xws = SecX.Sheets("SecX")


Set Lws = LipR.Sheets("Funds")




    With Lws
        For i = 2 To 10 'LwsRows



            If Lws.Range("A" & i).Value <> "" Then
            LipR.Sheets.Add(After:=LipR.Sheets(LipR.Sheets.Count)).Name = Lws.Range("A" & i).Value
            NewFund = Lws.Range("A" & i).Value
            Set Fsheet = LipR.Sheets(NewFund)               


            End If

                With Fsheet
                    FsheetRows = .Range("A" & .Rows.Count).End(xlUp).Row
                End With

                ....                    
                Set MatPhase = Fsheet.Range("O4:O" & FsheetRows)

                For Each MatVal In MatPhase.Cells
                    MatVal.Interior.ColorIndex = getColor(MatVal)
                Next MatVal

                Fsheet.Cells.EntireColumn.AutoFit

                Application.Goto _
                Reference:=Fsheet.Range("A1"), Scroll:=True

        Next i
    End With

ここで何が欠けていますか？私は本当にこれのために if/elseif を避けようとしていました。

ありがとうございました

4

2 に答える 2

1

私の推測では、関数を呼び出すサブルーチンで間違っていたと思います。以下は、ループしている範囲内の値が 0 から 100 の間である限り、関数を変更しなくても機能します。

私の例では、Sheet2 を使用し、FsheetRows を 20 に設定しています。セルの色がわかりにくい場合に備えて、列 O の値のコピーを含むスクリーンショットを列 P に含めました。ワークブックでオブジェクトを使用するには、必要に応じて変更します。

Sub ColorMyCells()

    Dim Fsheet As Worksheet
    Dim FsheetRows As Long

    Set Fsheet = ThisWorkbook.Sheets("Sheet2")
    FsheetRows = 20

    Dim MatVal As Range, MatPhase As Range

    Set MatPhase = Fsheet.Range("O4:O" & FsheetRows)

    For Each MatVal In MatPhase.Cells
        MatVal.Interior.ColorIndex = getColor(MatVal)
    Next MatVal
End Sub

これを実行すると、範囲は以下のスクリーン ショットの列 O のようになります。

select ステートメントでセルの色を設定する

于 2013-07-23T17:43:39.090 に答える
0

MatValあなたは単一のセル/範囲だと思います

Private Function getColor(ByVal MatVal As Range) As Integer

    Select Case MatVal.Value
        Case 0 To 1: getColor = 9
        Case 1.01 To 3: getColor = 46
        Case 3.01 To 5: getColor = 27
        Case 5.01 To 10: getColor = 4
        Case 10.01 To 20: getColor = 5
        Case 20.01 To 30: getColor = 11
        Case 30 To 100: getColor = 29
    End Select
End Function
于 2013-07-23T17:47:43.550 に答える