选择Case Loop

Question

我根据我在这里找到的另一个问题建模了一个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。

谢谢

Answer 1

我的猜测是你在调用该函数的sub中出错了。以下工作无需对您的功能进行任何修改，只要您在循环范围内的值介于0到100之间。

在我的示例中，我使用Sheet2并将FsheetRows设置为20.我在P列中包含了一个带有O列中值的副本的屏幕截图，以防单元格颜色难以看清。根据需要进行修改以使用工作簿中的对象。

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列：

Answer 2

我猜您的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