Вставить ячейку в форматирование условия

Question

поэтому у меня есть такой код:

Sub ApplyIconSets()

Dim rng As Range
Dim iset As IconSetCondition

Set rng = Application.InputBox("Select a Range", "Obtained Range Object", Type:=8)
rng.Name = "selected"

LastRow = Range("selected").Rows.Count
LastColumn = Range("selected").Columns.Count

With Range("selected")
    For i = 2 To LastColumn
        For r = 1 To LastRow
            Set iset = .Cells(r, i).FormatConditions.AddIconSetCondition
            With iset
                .IconSet = ActiveWorkbook.IconSets(xl3Arrows)
                .ReverseOrder = False
                .ShowIconOnly = False
            End With
            With iset.IconCriteria(2)
                .Type = xlConditionValueFormula
                .Operator = xlGreaterEqual
                .Value = Range("selected").Cells(r, i).Offset(, -1)
            End With
            With iset.IconCriteria(3)
                .Type = xlConditionValueFormula
                .Operator = xlGreaterEqual
                .Value = Range("selected").Cells(r, i).Offset(, -1)
            End With
        Next r
    Next i
End With

End Sub

Таким образом, в основном этот код применяет форматирование условия IconSet к ячейке на основе значения предыдущей ячейки.Код работает отлично, но есть один момент, который я хочу улучшить.

Когда я проверяю примененное условие, код вводит абсолютное значение предыдущей ячейки вместо местоположения ячейки. Like This

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

Я пытался изменить

.Value = Range("selected").Cells(r,i).Offset(,-1).Address 

Но он возвращает строку, следовательно, условие не будет работать.

Кто-нибудь знает решение?

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

Answer 1

Пожалуйста, попробуйте определить в каждом сегменте значение в виде ссылки на ячейку следующим образом:

With iset.IconCriteria(3)
   .Type = xlConditionValueFormula
   .Operator = xlGreaterEqual
   .Value = "=Sheet1!$B$1"
End With

Вам придется заменить строку с переменными на что-то вроде этого:

.Value = "=Sheet1!" & Range("selected").Cells(r, i).Offset(, -1).Address

---

Отметьте этот ответ, если это помогло вам.

Answer 2

Я не уверен, что вы правильно поняли логику условного формата. Ваш код в его нынешнем виде никогда не будет показывать желтую стрелку, потому что IconCriteria(3) будет оцениваться первым. Поскольку IconCriteria(2) имеет идентичные значения свойств, оно никогда не будет выполнено. Если вы хотите, чтобы зеленая стрелка отображалась для чисел, превышающих проверенное значение ячейки, а желтая стрелка отображалась для чисел, равных этому значению, вам нужно написать код, как показано ниже.

Мне также интересно, может ли цикл ForEach быть проще, особенно потому, что он будет проходить сам диапазон ячеек, чтобы вы могли просто извлечь из него вашу книгу и объекты листа. Это позволит избежать потенциальных проблем ваших неквалифицированных диапазонов. Вам просто нужно добавить оператор If, чтобы убедиться, что вы не пытались сместить за пределы первого столбца 1.

В целом, приведенный ниже код может служить вашим целям. Кстати, я бы рекомендовал добавить Option Explicit в верхней части вашего модуля и обрабатывать случай, когда пользователь нажимает кнопку Отмена в поле ввода:

Option Explicit

Sub ApplyIconSets()

    Dim sel As Range, cell As Range

    ' Acquire the target range and handle a cancelled input box.
    On Error GoTo Canx
    Set sel = Application.InputBox("Select a Range", "Obtained Range Object", Type:=8)

    ' Iterate cell by cell to add the condition.
    On Error GoTo EH
    For Each cell In sel.Cells

        'Ignore the cell if it is in column 1.
        If cell.Column > 1 Then

            With cell.FormatConditions
                'Delete existing conditions.
                .Delete
                'Add a new condition.
                With .AddIconSetCondition
                    .IconSet = cell.Worksheet.Parent.IconSets(xl3Arrows)
                    'Set the amber criterion.
                    'Note: we have to use '>=' but anything '>' will be caught
                    'in the green operator, so only '=' will meet this criterion.
                    With .IconCriteria(2)
                        .Type = xlConditionValueFormula
                        .Operator = xlGreaterEqual
                        .Value = "=" & cell.Worksheet.Name & "!" & cell.Offset(, -1).Address
                    End With
                    'Set the green criterion.
                    'Note: we have to use just '>' because this is evaluated first
                    'and '>=' would result in amber never capturing a value.
                    With .IconCriteria(3)
                        .Type = xlConditionValueFormula
                        .Operator = xlGreater
                        .Value = "=" & cell.Worksheet.Name & "!" & cell.Offset(, -1).Address
                    End With
                End With
            End With
        End If
    Next

    Exit Sub

Canx:
    Debug.Print "User cancelled."
    Exit Sub
EH:
    Debug.Print Err.Number; Err.Description
End Sub

Answer 3

Этот код делает то, что вы хотите.

Sub ApplyIconSets()

    Dim LastRow As Long, LastColumn As Long
    Dim Rng As Range
    Dim iSet As IconSetCondition
    Dim i As Integer, R As Integer

    Set Rng = Application.InputBox("Select a Range", "Obtained Range Object", Type:=8)
    Rng.Name = "selected"

    LastRow = Range("selected").Rows.Count
    LastColumn = Range("selected").Columns.Count

    With Range("selected")
        For i = 1 To LastColumn
            For R = 1 To LastRow
                Set iSet = .Cells(R, i).FormatConditions.AddIconSetCondition
                With iSet
                    .IconSet = ActiveWorkbook.IconSets(xl3Arrows)
                    .ReverseOrder = False
                    .ShowIconOnly = False
                End With
                With iSet.IconCriteria(2)
                    .Type = xlConditionValueFormula
                    .Operator = xlGreaterEqual
                    .Value = "=" & Range("selected").Cells(R, i).Offset(, -1).Address
                End With
                With iSet.IconCriteria(3)
                    .Type = xlConditionValueFormula
                    .Operator = xlGreaterEqual
                    .Value = "=" & Range("selected").Cells(R, i).Offset(, -1).Address
                End With
            Next R
        Next i
    End With
End Sub

Я не хотел тратить время на эксперименты: я думаю, что условие можно установить для всего диапазона за один раз, заставляя Excel устанавливать относительное форматирование вместо абсолютного. Вы можете попробовать это. Там будет разница в скорости. Вы также можете добавить код, который удаляет существующий CF перед применением нового. CF легко перегружается и замедляет работу вашего листа.