【问题标题】:writing with some vba code, hit a dead end! getting error end block end if without end if用一些vba代码写,死路一条!得到错误结束块结束如果没有结束如果
【发布时间】:2020-05-01 15:51:52
【问题描述】:

我正在创建仪表板。我有两个形状椭圆 1 和椭圆 2。它们将根据特定单元格的值改变颜色

我收到一个错误:

如果没有结束就阻塞

我在这里做错了什么!

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

【问题讨论】:

  • 您在If Intersect(Target, Range("N10")) Is Nothing Then Exit Sub 之前缺少一个End If
  • 这也是在乞求一些重构。有大量重复代码。
  • this may be useful。此外,正确缩进代码有助于避免此类错误。见this
  • 我添加到 End If,它使错误消失但它仍然无法正常工作。一个形状根据值改变颜色,第二个不改变颜色(椭圆形 2)我刚上学期,我还在学习,我相信代码会更好
  • @OscarNuñez - 如果代码不起作用,请调试(逐行执行)并查看它所采取的行为与您期望的行为。

标签: excel vba dashboard


【解决方案1】:

重构:

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

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 2021-12-03
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2016-03-27
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多