Excel VBA Select Case Loop Sub

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/1841215/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-11 11:04:03  来源:igfitidea点击:

Excel VBA Select Case Loop Sub

excelvbaselectloopscase

提问by Zack

In my excel file, I have a table setup with formulas.

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

with Cells from Range("B2:B12"), Range ("D2:D12"), and etc every other row containing the answers to these formulas.

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

for these cells (with the formula answers), I need to apply conditional formatting, but I have 7 conditions, so I've been using "select case" in VBA to change their interior background based on their number. I have the select case function currently set up within the sheet code, as opposed to it's own macro

对于这些单元格(带有公式答案),我需要应用条件格式,但我有 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

but using this method, you must be actually entering the value into the cell for the formatting to work.

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

which is why I want to write a subroutine to to do this as a macro. I can input my data, let the formulas work, and when everything is ready, I can run the macro and format those specific cells.

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

I want an easy way to do this, obviously I could waste a load of time, typing out all the cases for every cell, but I figured it'd be easier with a loop.

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

how would I go about writing a select case loop to change the formatting on a a specific range of cells every other row?

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

thank you in advance.

先感谢您。

回答by marg

Here is a very basic loop that goes through all cells in a range and sets the ColorIndex. (I did not try it but it should work)

这是一个非常基本的循环,它遍历范围内的所有单元格并设置 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

Edit:It works now. I forgot to add Interior infront of ColorIndex and set ByRef to ByVal. Btw. please add your comments as a comment to my answer.

编辑:它现在有效。我忘了在 ColorIndex 前面添加内部并将 ByRef 设置为 ByVal。顺便提一句。请将您的评论作为评论添加到我的答案中。

Edit2:Regarding your Errormsg when changing the value:

Edit2:关于更改值时的 Errormsg :

"Ambiguous name detected: setColor"

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

I guess you still have some code left in your worksheet_change. You did not mention how you want to run your Sub.

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

If you want to run it on worksheet_change you just need to add the code in the worksheet in vba (not the module) and call setcolor. There can be only one setColorso make sure that it is either in your module or your worksheet.

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

If you want to run it from a module you need to change

如果你想从一个模块运行它,你需要改变

Private Sub setColor()

to

Public Sub setColor()

And it would be better to add The worksheetname or ActiveSheet infront of your Range. Like this:

最好在 Range 前面添加 The worksheetname 或 ActiveSheet。像这样:

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

回答by shahkalpesh

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

EDIT: Go ahead to accept @marg's answer.
I have merely used his code & corrected a few things, which caused compile time error.

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