писать с некоторым кодом VBA, тупик! получение ошибки конец блока конец если без конца если - PullRequest
Новая
       10

писать с некоторым кодом VBA, тупик! получение ошибки конец блока конец если без конца если

0 голосов
/ 15 января 2020

Я создаю панель инструментов. У меня есть две формы: овальная 1 и овальная 2. Они должны менять цвет в зависимости от значения, заданного c ячейки

Я получаю сообщение об ошибке:

блок если без конца if

Что я здесь не так делаю! 

Sub Worksheet_Change(ByVal Target As Range)
'
    If Intersect(Target, Range("E10")) Is Nothing Then Exit Sub

        If Target.Value >= -0.1 And Target.Value <= 0.1 Then
            ActiveSheet.Shapes.Range(Array("Oval 1")).Select
                With Selection.ShapeRange.Fill
                .ForeColor.RGB = RGB(0, 176, 80)
                End With
        ElseIf Target.Value >= -0.29 And Target.Value < 0.29 Then
            ActiveSheet.Shapes.Range(Array("Oval 1")).Select
                With Selection.ShapeRange.Fill
                .ForeColor.RGB = RGB(255, 255, 0)
                End With
        Else
             ActiveSheet.Shapes.Range(Array("Oval 1")).Select
                With Selection.ShapeRange.Fill
                .ForeColor.RGB = RGB(255, 0, 0)

                End With



        If Intersect(Target, Range("N10")) Is Nothing Then Exit Sub

        If Target.Value >= -0.1 And Target.Value <= 0.1 Then
            ActiveSheet.Shapes.Range(Array("Oval 2")).Select
                With Selection.ShapeRange.Fill
                .ForeColor.RGB = RGB(0, 176, 80)
                End With
        ElseIf Target.Value >= -0.29 And Target.Value < 0.29 Then
            ActiveSheet.Shapes.Range(Array("Oval 2")).Select
                With Selection.ShapeRange.Fill
                .ForeColor.RGB = RGB(255, 255, 0)
                End With
        Else
             ActiveSheet.Shapes.Range(Array("Oval 2")).Select
                With Selection.ShapeRange.Fill
                .ForeColor.RGB = RGB(255, 0, 0)
                End With

    End If


    Range("A1").Select
End Sub

1 Ответ

2 голосов
/ 15 января 2020

Рефакторинг: 

Sub Worksheet_Change(ByVal Target As Range)

    If Target.CountLarge > 1 Then Exit Sub

    If Not Intersect(Target, Me.Range("E10")) Is Nothing Then
        Me.Shapes.Range("Oval 1").ShapeRange.Fill.ForeColor.RGB = ValueColor(Target.Value)
    End If

    If Not Intersect(Target, Me.Range("N10")) Is Nothing Then
        Me.Shapes.Range("Oval 2").ShapeRange.Fill.ForeColor.RGB = ValueColor(Target.Value)
    End If

End Sub

Function ValueColor(v) As Long
    Dim rv As Long
    If v > -0.1 And v <= 0.1 Then
        rv = RGB(0, 176, 80)
    ElseIf v.Value >= -0.29 And v.Value < 0.29 Then
        rv = RGB(255, 255, 0)
    Else
        rv = RGB(255, 0, 0)
    End If
    ValueColor = rv
End Function
...