Question

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

当我运行代码时，我收到“运行时错误'424'的错误消息：需要对象。”当我去调试问题时，它会突出显示我的.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（What：= MySearch（I），_ 之后：= ActiveCell，_ LookIn：= xlValues，_ LookAt：= xlPart，_ SearchOrder：= xlByRows，_ SearchDirection：= xlPrevious，_ SearchFormat：= FALSE）.Activate

Rng("H" & ActiveCell.Row) Rng是一个Range对象。它不像Range那样工作。你不能传递一个单元格地址。您可以执行此Rng(1,"H")这是Rng.cells(1,"H")位的真正简写，因为第2列Rng 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

<强>更新

以下是您问题的实际答案：

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范围，那就去做吧。但是，最好在VBA代码中远离Select，Activate等。我强烈建议您不要使用最后一行代码，并将代码调整为不依赖于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

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

显示运行时错误的调试模式。

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

3 个答案: