Excel VBA Select Case Loop Sub

В моем файле excel у меня есть таблица с формулами.

с ячейками из диапазона («B2: B12»), диапазона («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

но используя этот метод, вы должны фактически вводить значение в ячейку, чтобы форматирование работало.

вот почему я хочу написать подпрограмму, чтобы сделать это как макрос. Я могу ввести свои данные, позволить формулам работать, и когда все будет готово, я могу запустить макрос и отформатировать эти конкретные ячейки.

Мне нужен простой способ сделать это, очевидно, я мог бы потратить кучу времени, печатая все случаи для каждой ячейки, но я решил, что с циклом будет проще.

как мне написать цикл выбора регистра, чтобы изменить форматирование определенного диапазона ячеек в каждой второй строке?

заранее спасибо.


loops excel select vba case
person Zack    schedule 03.12.2009    source источник
comment
Вы можете использовать функцию «Добавить комментарий», которая присутствует под каждым ответом. Большое текстовое поле ниже можно использовать для ответа (решения). Поле комментариев можно использовать для обсуждения решения и комментариев к нему.   -  person shahkalpeshp    schedule 03.12.2009
comment
У вас есть логическая ошибка в вашем Select Case. Если каким-то образом кому-то удастся ввести 3 десятичных числа (скажем, .496), то случай не будет выбран. (То есть провалится.) Должен быть корпус .49 К .99, .99 К 1.99 и т.д.   -  person Oorang    schedule 04.12.2009

Ответы (2)


arrow_upward
1
arrow_downward

Вот очень простой цикл, который проходит по всем ячейкам в диапазоне и устанавливает 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

Изменить: теперь это работает. Я забыл добавить Interior перед ColorIndex и установить ByRef в ByVal. Кстати. пожалуйста, добавьте свои комментарии в качестве комментария к моему ответу.

Edit2: относительно сообщения об ошибке при изменении значения:

"Обнаружено неоднозначное имя: setColor"

Я думаю, у вас все еще остался код в вашем worksheet_change. Вы не упомянули, как вы хотите запустить свой Sub.

Если вы хотите запустить его на worksheet_change, вам просто нужно добавить код на рабочий лист в vba (не модуль) и вызвать setcolor. Может быть только один setColor, поэтому убедитесь, что он есть либо в вашем модуле, либо на вашем листе.

Если вы хотите запустить его из модуля, вам нужно изменить

Private Sub setColor()

to 

Public Sub setColor()

И было бы лучше добавить имя рабочего листа или ActiveSheet перед вашим диапазоном. Так:

Set area = ActiveSheet.Range("B2:L12")
person marg    schedule 03.12.2009

arrow_upward
0
arrow_downward 

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.
Я просто использовал его код и исправил несколько вещей, которые вызвали ошибку времени компиляции.

person shahkalpeshp    schedule 03.12.2009
comment
Спасибо. Я не знал, что вам нужно объявить элементы цикла foreach. - person marg; 03.12.2009