Как получить мой изменяющий цвет макрос VBA для чтения результата формулы?

Question

Я сделал макрос, который меняет цвет определенных символов в диапазоне ячеек.Однако макрос работает отлично, только если содержимое ячейки написано вручную.Я хочу, чтобы формула могла читать результат формулы в диапазоне вместо этого, потому что ячейки будут иметь различные комбинации x, y и 7 в соответствии с определенной пользователем функцией (набор операторов if), которую я сделал.Прямо сейчас макрос показывает неправильные цвета, когда содержимое ячейки не написано вручную.Ребята, можете ли вы мне помочь?

С наилучшими пожеланиями

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

Public Sub ChangeColor()
Dim MyRange As Range
Dim FarveZ As Integer
Dim FarveX As Integer
Dim Farve7 As Integer

    Set MyRange = Range("G32:R34")  

    FarveZ = 26   
    FarveX = 46   
    Farve7 = 3   

    For Each tempstring In MyRange
            If tempstring = "zx7" Then
                tempstring.Characters(Start:=1, Length:=1).Font.ColorIndex = FarveZ
                tempstring.Characters(Start:=2, Length:=1).Font.ColorIndex = FarveX
                tempstring.Characters(Start:=3, Length:=1).Font.ColorIndex = Farve7
            ElseIf tempstring = "zx" Then
                tempstring.Characters(Start:=1, Length:=1).Font.ColorIndex = FarveZ
                tempstring.Characters(Start:=2, Length:=1).Font.ColorIndex = FarveX
            ElseIf tempstring = "z7" Then
                tempstring.Characters(Start:=1, Length:=1).Font.ColorIndex = FarveZ
                tempstring.Characters(Start:=2, Length:=1).Font.ColorIndex = Farve7
            ElseIf tempstring = "x7" Then
                tempstring.Characters(Start:=1, Length:=1).Font.ColorIndex = FarveX
                tempstring.Characters(Start:=2, Length:=1).Font.ColorIndex = Farve7
            ElseIf tempstring = "z" Then
                tempstring.Characters(Start:=1, Length:=1).Font.ColorIndex = FarveZ
            ElseIf tempstring = "x" Then
                tempstring.Characters(Start:=1, Length:=1).Font.ColorIndex = FarveX
            ElseIf tempstring = "7" Then
                tempstring.Characters(Start:=1, Length:=1).Font.ColorIndex = Farve7
            Else
                Exit Sub
            End If
    Next tempstring

 End Sub

Я не получаю никаких сообщений об ошибках при запуске макроса.Это просто не подходит с правильными цветами.

Answer 1

Согласно моим комментариям, следующая процедура, настроенная и настроенная по вашему усмотрению, создаст копию результатов вашей формулы, на 10 строк ниже, с цветовой кодировкой согласно вашему коду.

Вы можете даже скрыть строки 32-34, если хотите, кодирование все еще может «видеть» значения и будет работать нормально.

Public Sub ChangeColor()
    Dim MyRange As Range
    Dim FarveZ As Integer
    Dim FarveX As Integer
    Dim Farve7 As Integer
    Dim Rowoffset As Long

    Set MyRange = Range("G32:R34")

    Rowoffset = 10 ' change this value to move the copy

    FarveZ = 26
    FarveX = 46
    Farve7 = 3

    For Each FormulaArea In MyRange
        Set OffsetData = FormulaArea.Offset(Rowoffset, 0)
        OffsetData.Value = FormulaArea.Value
        Select Case FormulaArea.Value
            Case "zx7"
                OffsetData.Characters(Start:=1, Length:=1).Font.ColorIndex = FarveZ
                OffsetData.Characters(Start:=2, Length:=1).Font.ColorIndex = FarveX
                OffsetData.Characters(Start:=3, Length:=1).Font.ColorIndex = Farve7
            Case "zx"
                OffsetData.Characters(Start:=1, Length:=1).Font.ColorIndex = FarveZ
                OffsetData.Characters(Start:=2, Length:=1).Font.ColorIndex = FarveX
            Case "z7"
                OffsetData.Characters(Start:=1, Length:=1).Font.ColorIndex = FarveZ
                OffsetData.Characters(Start:=2, Length:=1).Font.ColorIndex = Farve7
            Case "x7"
                OffsetData.Characters(Start:=1, Length:=1).Font.ColorIndex = FarveX
                OffsetData.Characters(Start:=2, Length:=1).Font.ColorIndex = Farve7
            Case "z"
                OffsetData.Characters(Start:=1, Length:=1).Font.ColorIndex = FarveZ
            Case "x"
                OffsetData.Characters(Start:=1, Length:=1).Font.ColorIndex = FarveX
            Case "7"
                OffsetData.Characters(Start:=1, Length:=1).Font.ColorIndex = Farve7
        End Select
    Next FormulaArea

End Sub

---

Немного более аккуратным способом сделать это было бы тестирование, основанное только на каждом символе:

Public Sub ChangeColor_version2()
    Dim MyRange As Range
    Dim FarveZ As Integer
    Dim FarveX As Integer
    Dim Farve7 As Integer
    Dim Rowoffset As Long
    Dim x as Long

    Set MyRange = Range("G32:R34")
    'For multiple tabs, specify the sheet that contains the formulas:
    'Set MyRange = Sheets("existing_sheet_name").Range("G32:R34")

    Rowoffset = 10 ' change this value to move the copy

    FarveZ = 26
    FarveX = 46
    Farve7 = 3

    For Each FormulaArea In MyRange
        Set OffsetData = FormulaArea.Offset(Rowoffset, 0)

        ' For multiple tabs, specify the destination sheet in the setting of the OffsetData range like this:
        ' Set OffsetData = Sheets("other_sheet_name").Range("A1").Offset(Rowoffset + FormulaArea.Row, FormulaArea.Column)

        OffsetData.Value = "'" & FormulaArea.Value
        For x = 1 To Len(FormulaArea.Value)
            With OffsetData.Characters(Start:=x, Length:=1)
            Select Case .Text
                Case "z"
                    .Font.ColorIndex = FarveZ
                Case "x"
                    .Font.ColorIndex = FarveX
                Case "7"
                    .Font.ColorIndex = Farve7
            End Select
            End With
        Next
    Next FormulaArea

End Sub