VBA код для автоцвета текста на основе происхождения

Question

В настоящее время я использую этот код для автоматической окраски шрифта в зависимости от его происхождения:

Sub Auto_Colour_Numbers()
   Dim rng As Range, 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))
           If CBool(Err) Then
               rng.Font.ColorIndex = 1 'black
           Else
               rng.Font.Color = RGB(0, 176, 80) 'green
           End If
           Err = 0
       ElseIf CBool(Len(rng.Value)) Then
           rng.Font.ColorIndex = 5 'blue
       Else
           rng.Font.ColorIndex = xlAutomatic 'default
       End If
   Next rng
   Set rErr = Nothing
End Sub

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

Он работает довольно хорошо, но есть пара проблем:

1) Если, например, у меня есть номер в ячейке A1, а затем поместить формулу "= A1 "в ячейке B1, макрос изменит цвет шрифта на зеленый, даже если он не извлекается из отдельного листа

2) Если у меня есть формула, например" = 5 + 5 ", а затем добавьте к немуячейка, связанная с другого листа, так что она становится, например, "= 5 + 5 + Sheet2! E8", она все равно станет черной, когда в идеале я бы хотел, чтобы она была зеленой.Я думал, что цикл if, который ищет восклицательные знаки, может сработать для этого?

Любая помощь будет высоко ценится (пожалуйста, не принимайте во внимание ни компетентность, ни знание VBA, поскольку я очень новичок в этом!)

Спасибо,

Томас

Answer 1

CF, вероятно, является подходящим вариантом, но если вы хотите решение VBA, попробуйте использовать событие смены листа, чтобы код запускался всякий раз, когда вы меняете ячейку.Поместите код в модуль листа (щелкните правой кнопкой мыши вкладку листа, просмотрите код и вставьте код).

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range

For Each rng In Target
    If rng.HasFormula Then
        If InStr(rng.Formula, "!") Then
            rng.Font.Color = RGB(0, 176, 80)
        Else
            rng.Font.ColorIndex = 1
        End If
    Else
        rng.Font.ColorIndex = 5
    End If
Next rng

End Sub

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

Sub x()

Dim rng As Range

For Each rng In Selection
    If rng.HasFormula Then
        If InStr(rng.Formula, "!") Then
            rng.Font.Color = RGB(0, 176, 80)
        Else
            rng.Font.ColorIndex = 1
        End If
    Else
        If Len(rng) > 0 Then rng.Font.ColorIndex = 5
    End If
Next rng

End Sub

Третий подход, использующий SpecialCells, который сводит к минимуму необходимое количество циклов.

Sub x()

Dim rng As Range, r1 As Range, r2 As Range

On Error Resume Next
Set r1 = Intersect(ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas), Selection)
Set r2 = Intersect(ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants, xlNumbers), Selection)
On Error GoTo 0

If Not r1 Is Nothing Then
    For Each rng In r1
        If InStr(rng.Formula, "!") Then
            rng.Font.Color = RGB(0, 176, 80)
        Else
            rng.Font.ColorIndex = 1
        End If
    Next rng
End If

If Not r2 Is Nothing Then r2.Font.ColorIndex = 5

End Sub

Answer 2

Если вы используете версию более раннюю, чем 2013, вот решение, которое не использует FormulaText:

Public Function RefDifSheet(Target As Range) As Boolean

    If Target.HasFormula Then
        RefDifSheet = InStr(Target.Formula, "!") <> 0
    Else
        RefDifSheet = False
    End If

End Function

Public Function IsFormula(Target As Range) As Boolean

    IsFormula = Target.HasFormula

End Function

Затем добавьте три правила условного формата в вашу ячейку:

• Первое правило: =RefDifSheet(A1)
• Второе правило: =IsFormula(A1)
• Третье правило: =ISNUMBER(A1)

Я думаю, что это также возможноиспользуя Macro4 функции и именованные диапазоны - пока не рассматривал это.(GET.CELLS - с использованием-excel-4-macro-functions )

Answer 3

Вот решение без VBA, использующее условное форматирование.

1. Чтобы отформатировать ячейки с помощью формулы, указывающей на другой лист, создайте условие форматирования с правилом =IFERROR(FIND("!",FORMULATEXT(A1)),FALSE) (заменяя началофактический диапазон данных для A1).
2. Чтобы отформатировать жестко заданные значения, создайте еще одно условие с правилом =ISNA(FORMULATEXT(A1)).

В результате получается

, где A1 жестко закодирован, A2 равен =A1 и A3 равен =Sheet2!A1.