VBA .Findnext 卡在循环上

如何解决VBA .Findnext 卡在循环上

我一直在尝试制作一个宏，以便在日期落入特定日期间隔时用整行突出显示日期。我遇到的问题是：当宏找到某个日期时，它会为该日期的整行着色，然后应该使用 .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 是约会？

解决方法

将 fAddress 变量和条件添加到循环中

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
dim fAddress as String
    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)
    if not c is nothing then 
        fAddress  = c.address
        Do 
           c.EntireRow.Interior.Color = vbCyan
           Set c = Dates.FindNext(c)
        Loop While Not c Is Nothing and fAddress  <> c.address
    end if
  Next DateLooper
Set c = Nothing
Next Cell
End Sub

,

请尝试下一个方法。未测试，但它应该足够快。它在数组元素之间进行迭代并将要着色的范围放入联合范围中，以立即着色，最后：

Private Sub CommandButton2_Click()
 Dim StartDate As Date,rngCol As Range,EndDate As Date
 Dim firstRow As Long,arrD,i As Long,rngH As Range

 Set rngH = Range("H2:H" & cells(rows.count,8).End(xlUp).row)
 arrD = rngH.value
 StartDate = Range("E2").value
 EndDate = Range("G2").value
 firstRow = rngH.Find(what:=Date,LookIn:=xlValues,lookat:=xlWhole).row - 1lookat:=xlWhole).row - 1
  For i = firstRow To UBound(arrD)
    If CDate(arrD(i,1)) = EndDate Then Exit For
    If CDate(arrD(i,1)) = StartDate Then
        If rngCol Is Nothing Then
            Set rngCol = cells(i + 1,1)
        Else
            Set rngCol = Union(rngCol,cells(i + 1,1))
        End If
    End If
  Next i
  If Not rngCol Is Nothing Then rngCol.EntireRow.Interior.Color = vbCyan
End Sub

假设 H:H 列按升序排序。

,

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

• 将开始和结束日期写入变量（E2、G2）。
• 循环遍历包含工作表名称的列 (H) 范围。
• 在每个工作表 (dws) 中，循环遍历日期 (DateLooper)，并尝试在日期列 ({{ 1}}).
• 如果找到，则突出显示单元格的整行。

代码

dCell