excel - VBA .Findnext 卡在循环上

Question

我一直在尝试制作一个宏来突出显示整个行的日期，如果它们落入特定的日期间隔。我遇到的问题是:当宏找到某个日期时，它会为该日期的整行着色，然后应该使用 .findnext 进入下一个 .find。然而宏在这里陷入了一个循环

Do While Not c Is Nothing
     c.EntireRow.Interior.Color = vbCyan
     Set c = Dates.FindNext
Loop

c 值为 2021.03.01(作为 StartDate)
我的代码如下所示:

        Private Sub CommandButton2_Click()
Dim c As Range
Dim first As String
Dim last As String
Dim StartDate As Date
Dim EndDate As Date
Dim DateLooper As Date

    first = CLng(Range("E2").Value)
    last = CLng(Range("G2").Value)

For Each Cell In ActiveSheet.Range("H2:H" & Cells(Rows.Count, 8).End(xlUp).Row)
  Sheet = Cell
  StartDate = first
  EndDate = last

  For DateLooper = StartDate To EndDate
    Set Dates = Worksheets(Sheet).Range("P:P")
    Set c = Dates.Find(What:=DateLooper)

        Do While Not c Is Nothing
        c.EntireRow.Interior.Color = vbCyan
        Set c = Dates.FindNext(c)
        Loop

  Next DateLooper
Set c = Nothing
Next Cell
End Sub

这里有什么问题？感谢您的时间和帮助。
也许是因为 c 是约会？

Answer 1

使用标准突出显示整行单元格

将开始和结束日期写入变量( E2 ， G2 )。

循环通过包含工作表名称的列 (H) 范围。

在每个工作表 ( dws ) 中，循环遍历日期 ( DateLooper )，并尝试在日期列 ( dCell ) 的单元格 ( P ) 中查找日期。

如果找到，突出显示单元格的整行。

代码

Option Explicit

Private Sub CommandButton2_Click()
    
    Dim ws As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim sws As Worksheet: Set sws = ActiveSheet
    Dim StartDate As Date: StartDate = sws.Range("E2").Value
    Dim EndDate As Date: EndDate = sws.Range("G2").Value
    Dim wrg As Range
    Set wrg = sws.Range("H2", sws.Cells(sws.Rows.Count, "H").End(xlUp))
    
    Dim dws As Worksheet
    Dim drg As Range
    Dim dCell As Range
    Dim wCell As Range
    Dim DateLooper As Date
    Dim fAddr As String
    
    For Each wCell In wrg.Cells ' loop through list of worksheet names
        Set dws = wb.Worksheets(wCell.Value)
        Set drg = dws.Range("P2", dws.Cells(dws.Rows.Count, "P").End(xlUp))
        For DateLooper = StartDate To EndDate ' loop through dates
            Set dCell = drg.Find(What:=DateLooper) ' find dates
            If Not dCell Is Nothing Then
                fAddr = dCell.Address
                Do
                    dCell.EntireRow.Interior.Color = vbCyan
                    Set dCell = drg.FindNext(dCell)
                Loop Until dCell.Address = fAddr
            End If
            Set dCell = Nothing
        Next DateLooper
    Next wCell

End Sub