Question

在我的Excel文件中，我有一个包含公式的表设置。

来自范围的单元格（“B2：B12”），范围（“D2：D12”）等，每隔一行包含这些公式的答案。

对于这些单元格（公式答案），我需要应用条件格式，但我有7个条件，所以我一直在VBA中使用“select case”来根据它们的数量改变它们的内部背景。我有当前在工作表代码中设置的选择案例功能，而不是它自己的宏

Private Sub Worksheet_Change(ByVal Target As Range)
Dim iColor As Integer
    If Not Intersect(Target, Range("B2:L12")) Is Nothing Then
        Select Case Target
            Case 0
                iColor = 2
            Case 0.01 To 0.49
                iColor = 36
            Case 0.5 To 0.99
                iColor = 6
            Case 1 To 1.99
                iColor = 44
            Case 2 To 2.49
                iColor = 45
            Case 2.5 To 2.99
                iColor = 46
            Case 3 To 5
                iColor = 3
        End Select
        Target.Interior.ColorIndex = iColor
    End If
End Sub

但是使用此方法，您必须实际将值输入单元格才能使格式化。

这就是为什么我想写一个子程序来做这个宏作为原因。我可以输入我的数据，让公式工作，当一切准备就绪时，我可以运行宏并格式化那些特定的单元格。

我想要一个简单的方法来做到这一点，显然我可以浪费大量的时间，为每个单元格输入所有的情况，但我认为循环更容易。

我将如何编写一个选择案例循环来更改每隔一行特定范围的单元格的格式？

提前谢谢。

Answer 1

这是一个非常基本的循环，遍历范围内的所有单元格并设置ColorIndex。（我没试过，但应该有效）

Private Function getColor(ByVal cell As Range) As Integer
    Select Case cell
        Case 0
            getColor = 2: Exit Function
        Case 0.01 To 0.49
            getColor = 36: Exit Function
        Case 0.5 To 0.99
            getColor = 6: Exit Function
        Case 1 To 1.99
            getColor = 44: Exit Function
        Case 2 To 2.49
            getColor = 45: Exit Function
        Case 2.5 To 2.99
            getColor = 46: Exit Function
        Case 3 To 5
            getColor = 3: Exit Function
    End Select
End Function

Private Sub setColor()
Dim area As Range
Dim cell As Range

Set area = Range("B2:L12")
    For Each cell In area.Cells
        cell.Interior.ColorIndex = getColor(cell)
    Next cell
End Sub

编辑：现在可以使用了。我忘了添加ColorIndex的Interior infront并将ByRef设置为ByVal。顺便说一句。请将您的评论作为评论添加到我的答案中。

Edit2：关于更改值时的Errormsg：

“检测到不明确的名称：setColor”

我猜你的workheet_change还剩下一些代码。你没有提到你想如何运行你的Sub。

如果你想在worksheet_change上运行它，你只需要在vba（而不是模块）的工作表中添加代码并调用setcolor。 只能有一个setColor ，因此请确保它位于您的模块或工作表中。

如果您想从模块运行它，您需要更改

Private Sub setColor()

到

Public Sub setColor()

最好在您的Range范围内添加工作表名称或ActiveSheet。像这样：

Set area = ActiveSheet.Range("B2:L12")

Answer 2

Option Explicit
Private Function getColor(cell As Range) As Integer
    Select Case cell
        Case 0
            getColor = 2: Exit Function
        Case 0.01 To 0.49
            getColor = 36: Exit Function
        Case 0.5 To 0.99
            getColor = 6: Exit Function
        Case 1 To 1.99
            getColor = 44: Exit Function
        Case 2 To 2.49
            getColor = 45: Exit Function
        Case 2.5 To 2.99
            getColor = 46: Exit Function
        Case 3 To 5
            getColor = 3: Exit Function
    End Select
End Function
Public Sub setColor()
Dim area As Range
Dim cell As Range

Set area = Range("B2:L12")
    For Each cell In area.Cells
        cell.Interior.ColorIndex = getColor(cell)
    Next cell
End Sub

编辑：继续接受@ marg的回答我只是使用他的代码＆amp;纠正了一些事情，导致编译时错误。

Excel VBA Select Case Loop Sub

2 个答案: