Excel VBA Select Case Loop Sub

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 

，但使用这种方法，你必须是实际进入价值进入细胞的格式化工作。

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

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

我将如何去编写一个select case循环来改变每隔一行的特定范围的单元格的格式？

谢谢你提前。

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。 Btw。请添加您的评论作为评论我的答案。

EDIT2：关于你ERRORMSG改变值时：

“检测明确名称：的setColor”

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

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

如果你想从你需要改变

Private Sub setColor() 

到

Public Sub setColor() 

模块运行它，它会更好，添加的worksheetname或你的范围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 

编辑：来吧，接受@玛格的答案。
我只是用他的代码&纠正了几件事情，从而导致编译时错误。