Question

我正在尝试创建一个宏来搜索特定内部颜色的文本列（A：A）。在这种情况下，内部颜色为55.通常我会创建一系列A1:A101但添加的数据每天都会更改，因此可能会有更多或更少。

基本上，一旦宏识别具有颜色的单元格，我希望宏向单元格添加注释。简单的事情就像＆＃34; Hello World！＆＃34;。

到目前为止，这就是我所拥有的：

Sub AddCommentBasedOnColor()
Dim rng As Range, cell As Range

Set rng = Range("G:G")

Application.ScreenUpdating = False
Application.Calculation = xlManual
For Each cell In rng
    If cell.Interior.ColorIndex = 55 Then
        If rng.Comment Is Nothing Then rng.AddComment
        rng.Comment.Text "Possible Aux Stacking"
        End
    End If
Next cell

Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

我遇到的问题是，当我运行代码时，注释部分根本不起作用。没有评论，由于某种原因，我得到一个调试代码，但之前没有。不知道我做了什么改变了它。

此外，当我删除此代码的评论部分时，它确实需要一些时间来运行，任何缩短这段时间的帮助也会受到赞赏。

Answer 1

您的代码存在逻辑问题。

使用rng.AddComment，您尝试为整个列G设置注释，因为rng是整个列G.这是不可能的。

您的内部If语句的工作原理如下：

...
If rng.Comment Is Nothing Then rng.AddComment
rng.Comment.Text "Possible Aux Stacking"
End
...

如果rng.Comment没有，那么rng.AddComment。这里If结束。下一个程序行正在处理，没有附加条件，End然后在此时结束Sub。

为了缩短处理时间，您不必在G列中的所有行上运行。这可以通过计算最后使用的行来实现。如何执行此操作会因您定义上次使用的行的方式而异。由于您正在处理单元格的内部，因此我将最后使用的行定义为具有非默认内容为空单元格的单元格的最后一行。

Sub AddCommentBasedOnColor()
Dim rng As Range, cell As Range, lastUsedRow As Long

With ActiveSheet
    lastUsedRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
    Set rng = .Range("G1:G" & lastUsedRow)

    For Each cell In rng
        If cell.Interior.ColorIndex = 55 Then
            If cell.Comment Is Nothing Then
                cell.AddComment
                cell.Comment.Text "Possible Aux Stacking"
            End If
        End If
    Next cell

End With
End Sub

Answer 2

您可以使用Find而不是遍历每个单元格：

Sub AddCommentBasedOnColor()

Dim rng1 As Range
Dim rng2 As Range
Dim strFirst As String

Application.FindFormat.Interior.ColorIndex = 55

Set rng1 = Columns("G:G").Find(What:="", SearchDirection:=xlNext, SearchFormat:=True)
If Not rng1 Is Nothing Then
    strFirst = rng1.Address
    Set rng2 = rng1
        Do
            Set rng2 = Columns("G:G").Find(What:="", After:=rng2, SearchDirection:=xlNext, SearchFormat:=True)
            If rng2.Comment Is Nothing Then
                rng2.AddComment
                rng2.Comment.Text "Possible Aux Stacking"
            End If
        Loop Until rng2.Address = strFirst
End If

End Sub

查找具有特定颜色的范围内的单元格并添加注释

2 个答案: