如何在Excel中选择具有设置单元格颜色的日期？

Question

我想在excel VBA中创建一个宏，它通过一个循环在列“B”中搜索ActiveCell的值的范围（B1：B30）。除了搜索Column之外，我还想检查日期的单元格是否使用特定颜色着色。如果日期的单元格等于设置的颜色“好”，那么我希望它将同一行的H列中单元格的颜色更改为红色。

当我运行代码时，出现“运行时错误424”的错误消息：Object required。“当我去调试问题时，它突出显示了我找到的.Find函数并指向最后一个搜索行是“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 

Showing the Debug mode of the run-time error.

Screenshot of the Spreadsheet for reference

Answer 1

代码审查：

您在这里有几个问题。

MySearch = Array(ActiveCell)将始终是单个值。那么为什么麻烦穿过它

你不能设置范围等于range.activate。搜索Sheets("Sheet1").Range("B1:B30")意味着您正在搜索其他ActiveSheet的工作表。如果是这种情况，.Find(After:=Activecell)表明您正在寻找另一个工作表的ActiveCell之后的值。

设置RNG = .Find（什么：= MYSEARCH（I），_ 后：= ActiveCell，_ 看着：= xlValues，_ 注视：= xlPart，_ SearchOrder：= xlByRows，_ SearchDirection： = xlPrevious，_ SearchFormat：= False）.Activate

Rng("H" & ActiveCell.Row) Rng是一个Range对象。它不适用于Range。你不能通过它一个单元格地址。你可以这样做Rng(1,"H")这实际上是Rng.cells(1,"H")位的简写位，这是误导因为Rng在列2中Rng(1,"H")将引用列I中的值。

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 

---

UPDATE：

下面是实际的回答你的问题：

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在find你正在尝试做的方式结束。

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

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代码。我强烈建议不要使用最后一行代码，并将代码调整为不依赖于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