0

在我的 excel 文件中，我有一个带有公式的表格设置。

使用来自 Range("B2:B12")、Range ("D2:D12") 等的单元格，每隔一行包含这些公式的答案。

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

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

但是使用这种方法，您必须将值实际输入到单元格中才能使格式生效。

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

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

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

先感谢您。

4

2 回答 2

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 的前面添加内部并将 ByRef 设置为 ByVal。顺便提一句。请添加您的评论作为对我的回答的评论。

Edit2：关于更改值时的 Errormsg：

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

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

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

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

Private Sub setColor()

至

Public Sub setColor()

最好在 Range 前面添加工作表名称或 ActiveSheet。像这样：

Set area = ActiveSheet.Range("B2:L12")
于 2009-12-03T17:03:31.403 回答
0 
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 的回答。
我只是使用了他的代码并纠正了一些导致编译时错误的事情。

于 2009-12-03T18:11:09.610 回答