【问题标题】:Use Excel-VBA to colour a range y if value is certain number is placed AND colour range x if value is certain number is placed如果值是某个数字,则使用 E​​xcel-VBA 为范围 y 着色,如果值是某个数字,则颜色范围 x 被放置
【发布时间】:2018-12-12 16:07:58
【问题描述】:

我需要在 Excel VBA (2016) 中编写条件格式,而不使用现有的条件格式工具。由于我是新手并且尝试了一段时间以下,我请求你帮助我。

我想写这个,例如在私有子中:对于 E18:G18 和 K1:K10 范围:

如果值 >=1,则颜色 = 绿色

如果值为

对于范围 B1:B10

如果值 >=3,则颜色 = 绿色

如果值为 0,则颜色为黄色

如果值为 0 或 "" 红色

我的代码如下 - 当我保存它时,在我的第二个定义范围 (K1:K10) 内没有任何反应,在重新打开 excel 工作簿之后也是如此。

我的第二个条件格式范围 (B1:B10) 也没有任何反应:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngObserve As Range, rngCell As Range

Set rngObserve = Intersect(Target, Range("E18:G18, K1:K10"))

If rngObserve Is Nothing Then
    Exit Sub
End If
For Each rngCell In rngObserve.Cells
    If Not Intersect(rngCell, rngObserve) Is Nothing Then
        If rngCell.Value = vbNullString Then
            rngCell.Interior.Color = xlNone
        ElseIf rngCell.Value < 1 Then
            rngCell.Interior.ColorIndex = 3 'red
        ElseIf rngCell.Value >= 1 Then
            rngCell.Interior.ColorIndex = 4 'green
        Else
            rngCell.Interior.ColorIndex = 3 'red
        End If
    End If
Next



Dim rngObserve As Range, rngCell As Range

Set rngObserve = Intersect(Target, Range("B1:B10"))

If rngObserve Is Nothing Then
    Exit Sub
End If
For Each rngCell In rngObserve.Cells
    If Not Intersect(rngCell, rngObserve) Is Nothing Then
        If rngCell.Value = vbNullString Then
            rngCell.Interior.Color = xlNone
        ElseIf rngCell.Value < 3 And rgncell.Value > 0 Then
            rngCell.Interior.ColorIndex = 6 'yellow
        ElseIf rngCell.Value >= 3 Then
            rngCell.Interior.ColorIndex = 4 'green
        Else
            rngCell.Interior.ColorIndex = 3 'red
        End If
    End If
Next

End Sub

【问题讨论】:

  • 请格式化您的代码...
  • 每张表只能有一个更改事件,因此您需要合并到一个子中。可能还有其他问题。你把代码放在相关的sheet模块里了吗?
  • 只是好奇,你为什么要这样?
  • 因为我在使用条件格式化工具和使用 vba 代码时遇到了一些麻烦。否则无法识别颜色...

标签: excel vba


【解决方案1】:

如 cmets 中所述,您只能有一个 Worksheet_Change 子例程。此代码应该可以满足您的需求:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngObserve As Range, rngCell As Range

'PGCodeRider comment: I'd set these to named ranges instead of hard-coded addresses
Set rngObserve = Intersect(Target, Range("E18:G18, K1:K10"))

    If Not rngObserve Is Nothing Then

        For Each rngCell In rngObserve.Cells

    If rngCell.Value = vbNullString Then
        rngCell.Interior.Color = xlNone
    ElseIf rngCell.Value < 1 Then
        rngCell.Interior.ColorIndex = 3 'red
    ElseIf rngCell.Value >= 1 Then
        rngCell.Interior.ColorIndex = 4 'green
    Else
        rngCell.Interior.ColorIndex = 3 'red
    End If

        Next rngCell

    End If


Set rngObserve = Intersect(Target, Range("B1:B10"))

    If Not rngObserve Is Nothing Then

        For Each rngCell In rngObserve.Cells

            If rngCell.Value = vbNullString Then
                rngCell.Interior.Color = xlNone
            ElseIf rngCell.Value < 3 And rngCell.Value > 0 Then
                rngCell.Interior.ColorIndex = 6 'yellow
            ElseIf rngCell.Value >= 3 Then
                rngCell.Interior.ColorIndex = 4 'green
            Else
                rngCell.Interior.ColorIndex = 3 'red
            End If

        Next rngCell

    End If
End Sub

【讨论】:

  • 谢谢!不幸的是,只有 E18:G18 范围有效。对于所有其他人来说,没有任何变化,只是普通的白色单元格......
  • 错误。将上面的代码插入一个空白的 excel 表中...将单元格 B3 的值更改为 3 它变为绿色。将B4 的值更改为 0,它会变成红色。将B1 的值更改为 1,它会变成黄色。什么不适合你?
  • 我确实在您的 AND 语句的代码中看到了一个错误。我在答案中更正了这一点。
  • 是的...我输入了错误的变量。这往往很重要......对不起。我纠正了它。另请参阅我关于使用命名范围而不是硬编码地址的评论。
  • PGCodeRider:感谢您的评论 - 命名范围是什么意思?
猜你喜欢
  • 2015-03-13
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2017-07-10
  • 2018-02-19
  • 1970-01-01
  • 2011-04-20
  • 1970-01-01
相关资源
最近更新 更多