Как мне раскрасить ячейки кода на основе входных данных?Нашел код, но не понял, "как" - PullRequest
1 голос
/ 24 июня 2019

Мне нужно раскрасить ячейки кода в зависимости от того, что находится в этой ячейке.

  • Жесткие цифры: синий
  • Другая ссылка на лист: зеленая
  • Формулы: черный
Sub mcrFinancial_Color_Codes()
    Dim rng As Range
    Dim rErr As Range

    On Error Resume Next
    For Each rng In Intersect(ActiveSheet.UsedRange, Selection)
        If rng.HasFormula Then
            Set rErr = Range(Mid(rng.Formula, 2, Len(rng.Formula) - 1)) 'Somehow sees if formula references another sheet???
            If CBool(Err) Then
                rng.Font.ColorIndex = 1 'black
            Else
                rng.Font.ColorIndex = 10 'green
            End If
            Err = 0
        ElseIf CBool(rng.Value) Then
            rng.Font.ColorIndex = 5 'blue
        Else
            rng.Font.ColorIndex = xlAutomatic 'default
        End If
    Next rng
    Set rErr = Nothing
End Sub

Я нашел этот код, но некоторые вещи я не понимаю после If rng.HasFormula

1) Что делает Set rErr и как он дифференцирует формулы со ссылками на ячейки, которые содержат восклицательный знак (!).

2) rErr является переменной, но на нее фактически нет ссылок, кроме как в Err. R представляет что-то?

3) If CBool(Err). Это как-то возвращает true для Err и помечает его черным, иначе зеленым. Как он получает логическое значение от Err?

1 Ответ

1 голос
/ 24 июня 2019

Эта процедура работает посредством обработки ошибок

Mid(rng.Formula, 2, Len(rng.Formula) - 1)

Эта часть извлекает адрес из формулы в ячейке, например, если у вас была формула =Sheet1!$A$1, она получит Sheet1!$A$1, который является адресом диапазона.

Set rErr = Range(Mid(rng.Formula, 2, Len(rng.Formula) - 1))

Здесь мы устанавливаем диапазон с полученным адресом.Обычно, если адрес недействителен, VBA Editor выдаст ошибку, но с On Error Resume Next , которая может быть использована для отключения процедуры обработки ошибок, мы намеренно игнорируем эту ошибку, и процедура не останавливается.

Err Object содержит информацию об ошибках во время выполнения.Свойство по умолчанию Err - .Number, которое указывает ошибку времени выполнения.Если ошибки не произошло (в данном случае адрес был действительным) Err.Number = 0 или Err = 0, в противном случае он больше нуля.

CBool(Err)

CBool ​​ - функция преобразования типа.Он преобразует 0 в ЛОЖЬ и любое другое число в ИСТИНА.Если произошла ошибка, ее число будет больше 0 => CBool(Err) = True

r в rErr, скорее всего, означает Range, но это всего лишь предположение.


Вы можете попробовать что-то вроде этого, хотя это все еще неуклюже:

Sub mcrFinancial_Color_Codes()

    Dim LoopCell As Range
    Dim Checker As Range

    For Each LoopCell In Intersect(ActiveSheet.UsedRange, Selection)
        With LoopCell
            Select Case True
                Case .HasFormula
                    On Error Resume Next
                    Set Checker = Range(Mid(rng.Formula, 2, Len(rng.Formula) - 1))
                    On Error GoTo 0
                    If Checker Is Nothing Then
                        .Font.ColorIndex = 1
                    Else
                        .Font.ColorIndex = 10
                    End If

                Case .Value <> 0
                    .Font.ColorIndex = 5

                Case Else
                    .Font.ColorIndex = xlAutomatic
            End Select
        End With
    Next LoopCell

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...