如何在Excel中select一个设置单元格颜色的date？

我正在尝试在Excel VBA中创build一个macros，它通过一个循环search列“B”中的ActiveCell的值的范围（B1：B30）。 随着Column的search，我也想检查date的单元格是否用特定的颜色着色。 如果date的单元格等于设置的颜色“良好”，那么我希望它将同一行的H列中的单元格颜色更改为红色。

当我运行代码时，出现“运行时错误424”的错误消息：Object required。“当我去debugging问题时，它突出显示了我find的.Find函数，并指向search的最后一行这是“SearchFormat：= False）。激活”我该怎么办才能解决这个问题？ 任何改善我的整体代码将非常感激。

Sub Find() Dim FirstAddress As String Dim MySearch As Variant Dim Rng As Range Dim I As Long MySearch = Array(ActiveCell) With Sheets("Sheet1").Range("B1:B30") For I = LBound(MySearch) To UBound(MySearch) Set Rng = .Find(What:=MySearch(I), _ After:=ActiveCell, _ LookIn:=xlValues, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ SearchFormat:=False).Activate If Not Rng Is Nothing Then FirstAddress = Rng.Address Do If ActiveCell.Style.Name = "Good" Then Rng("H" & ActiveCell.Row).Select Rng.Interior.ColorIndex = xlColorIndexRed End If Set Rng = .FindNext(Rng) Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress End If Next I End With End Sub 

显示运行时错误的debugging模式。

电子表格的屏幕截图供参考

Answer 1

代码审查：

这里有几个问题。

MySearch = Array(ActiveCell)将永远是一个单一的值。 那么为什么麻烦循环

您无法将范围设置为等于range.activate。 searchSheets("Sheet1").Range("B1:B30")意味着您正在search其他ActiveSheet的工作表。 如果是这种情况比.Find(After:=Activecell)build议您在另一个工作表的ActiveCell之后寻找一个值。

设置Rng = .Find（What：= MySearch（I），_ After：= ActiveCell，_ LookIn：= xlValues，_ LookAt：= xlPart，_ SearchOrder：= xlByRows，_ SearchDirection：= xlPrevious，_ SearchFormat：= False） 。启用

Rng("H" & ActiveCell.Row) Rng是一个Range对象。 它不能像Range一样工作。 你不能通过它的单元格地址。 你可以这样做Rng(1,"H") ，它是Rng.cells(1,"H")位的简写，因为Rng在第2列Rng(1,"H")会Rng(1,"H")误导。专栏一

 Sub Find() Dim FirstAddress As String Dim MySearch As Variant Dim Rng As Range Dim I As Long MySearch = ActiveCell 'This is the ActiveCell of the ActiveSheet not necessarily Sheets("Sheet1") With Sheets("Sheet1").Range("B1:B30") Set Rng = .Find(What:=MySearch, _ After:=.Range("B1"), _ LookIn:=xlValues, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ SearchFormat:=False) If Not Rng Is Nothing Then FirstAddress = Rng.Address Do If Rng.Style.Name = "Good" Then .Range("H" & Rng.Row).Interior.ColorIndex = xlColorIndexRed End If Set Rng = .FindNext(Rng) Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress End If End With End Sub 

---

更新：

这里是你的问题的实际答案：

 Sub FindMatchingValue() Const AllUsedCellsColumnB = False Dim rFound As Range, SearchRange As Range If AllUsedCellsColumnB Then Set SearchRange = Range("B1", Range("B" & Rows.count).End(xlUp)) Else Set SearchRange = Range("B1:B30") End If If Intersect(SearchRange, ActiveCell) Is Nothing Then SearchRange.Select MsgBox "You must select a cell in the highlighted area before continuing", vbInformation, "Action Cancelled" Exit Sub End If Set rFound = SearchRange.Find(What:=ActiveCell.Value, _ After:=ActiveCell, _ LookIn:=xlValues, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ SearchFormat:=False) If Not rFound Is Nothing Then Do If rFound.Style.Name = "Good" Then Range("H" & rFound.Row).Interior.Color = vbRed End If Set rFound = SearchRange.FindNext(rFound) Loop While Not rFound Is Nothing And rFound.Address <> ActiveCell.Address End If End Sub 

Answer 2

你不能把Activate放在你想要做的事情的最后。

尝试这个，因为你发现声明。

 Set Rng = .Find(What:=MySearch(I), _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False, _ SearchFormat:=False) Rng.Activate 

那么如果你想Activate范围，那么做。 但是，最好远离Select ， Activate等VBA代码。 我强烈build议不要使用最后一行代码，并将代码调整为不依赖于“ Select和“ Activate 。

Answer 3

您可能需要考虑自动过滤方法，以便仅循环通过相关的单元格，如下所示：

 Option Explicit Sub Find() Dim cell As Range With Sheets("Sheet1").Range("B1:B30") .Rows(1).Insert '<--| insert a dummy header cell to exploit Autofilter. it'll be removed by the end With .Offset(-1).Resize(.Rows.Count + 1) '<--| consider the range expanded up to the dummy header cell .Rows(1) = "header" '<--| give the dummy header cell a dummy name .AutoFilter field:=1, Criteria1:=ActiveCell '<--| filter range on the wanted criteria If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then '<--| if any cell other than "header" one has been filtered... For Each cell In .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible) '<--| ... loop through filtered cells only If cell.Style.Name = "Good" Then cell.Offset(, 6).Interior.ColorIndex = 3 '<--| ... and color only properly styled cells Next cell End If .AutoFilter '<--| .. show all rows back... End With .Offset(-1).Resize(1).Delete '<--|delete dummy header cell End With End Sub