find特定颜色范围内的单元格并添加注释

我正在尝试创build一个macros来search特定内部颜色的文本列（A：A）。 在这种情况下，内部颜色是55.通常我会创build一个A1:A101的范围，但添加的数据每天都在变化，所以可能会更多或更less。

本质上，一旦macros用颜色标识单元格，我希望macros向单元格添加注释。 一些简单的“Hello World！”。

到目前为止，这是我的：

 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 

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

此外，当我删除此代码的评论部分，它需要一些时间来运行，任何协助缩短这段时间也将不胜感激。

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是Nothing然后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