find the first “To Date”, select the cells under “To Date” paste the value in the previous cells then go to the next To Date

问题

I need your help in order to fix this code. Objective of this code is set a range. find the first "To Date", then select all the cells under "To Date" paste the value in the previous cells (for example the first "To Date" is in cell F4 contains value from F5:F"N"(N=last row) then paste F5:F"N" values in E5:E"N", then go to the next To Date.

The problem I am facing in this code is that

1. the Code does not select the last row in under the "To Date" (except for the first time)

2. the code runs in infinite loop does not stop after the last "To Date"

   Sub FindAddressColumn()
   
   Dim twb As ThisWorkbook
   Dim ws As Worksheet
   Dim lastRow As Long
   Dim LastCol As Long
   Dim lr As Long
   Dim getLastCell As Range
   Dim firstAddress As String
   Dim rngAddress As Range
   Const strFindMe As String = "To Date"
   
   Set twb = ThisWorkbook
   For Each ws In twb.Worksheets
   
    If ws.Name = "QCR Summary" Then
    lastRow = ws.Cells.Find("*", ws.Cells(1, 1), xlFormulas, xlPart, xlByRows, _
                                    xlPrevious).Row
    LastCol = ws.Cells.Find("*", ws.Cells(1, 1), xlFormulas, xlPart, xlByColumns, _
                                    xlPrevious).Column
      Set getLastCell = ws.Cells(lastRow, LastCol)
   
    With ws.Range("A1", getLastCell)
      Set rngAddress = .Find(What:=strFindMe, LookIn:=xlValues)
   
        If rngAddress Is Nothing Then
        Exit Sub
        End If
   
        firstAddress = rngAddress.Address
   
        Do
         Set rngAddress = .FindNext(rngAddress)
         Range(rngAddress, rngAddress.End(xlDown)).Select
         'MsgBox rngAddress.Address
        Loop While Not rngAddress Is Nothing And rngAddress <> firstAddress
    End With
    End If
    Next ws
    End Sub
   

回答1:

Because you named your variable rngAddress the names suggests that the variable contains an address string while it actually contains a Range object.

Then you compare rngAddress <> firstAddress but if you have a look at your variable declarations

Dim firstAddress As String
Dim rngAddress As Range

You see that you compare a Range object with a String which cannot work properly. Because rngAddress is a range object it defaults to rngAddress.Value so you actually compare the value of the cell rngAddress with an address string firstAddress.

Replace

Loop While Not rngAddress Is Nothing And rngAddress <> firstAddress

with

Loop While rngAddress.Address <> firstAddress

Note that you can omit the part Not rngAddress Is Nothing here in the loop because that can never happen. If it would be Nothing then it would have already Exit Sub in the step earlier where you checked If rngAddress Is Nothing Then.

Also Dim twb As ThisWorkbook this should error because it must be Dim twb As Workbook.

Finally your loop is a bit unnecessary, because you can access your sheet named QCR Summary directly without looping throug all worksheets. Which would be much quicker:

Option Explicit

Public Sub FindAddressColumn()
    Const strFindMe As String = "To Date"
    
    Dim twb As Workbook
    Set twb = ThisWorkbook
    
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = twb.Worksheets("QCR Summary")
    On Error GoTo 0
    If ws Is Nothing Then
        MsgBox "Worksheet 'QCR Summary' does not exist."
        Exit Sub
    End If
    
    Dim lastRow As Long
    lastRow = ws.Cells.Find("*", ws.Cells(1, 1), xlFormulas, xlPart, xlByRows, _
                                     xlPrevious).Row
    Dim LastCol As Long
    LastCol = ws.Cells.Find("*", ws.Cells(1, 1), xlFormulas, xlPart, xlByColumns, _
                                     xlPrevious).Column
    
    Dim getLastCell As Range
    Set getLastCell = ws.Cells(lastRow, LastCol)
    
    With ws.Range("A1", getLastCell)
        Dim rngAddress As Range
        Set rngAddress = .Find(What:=strFindMe, LookIn:=xlValues)
    
        If rngAddress Is Nothing Then
            Exit Sub
        End If
        
        Dim firstAddress As String
        firstAddress = rngAddress.Address
    
        Do
            Set rngAddress = .FindNext(rngAddress)
            Range(rngAddress, rngAddress.End(xlDown)).Select
            'MsgBox rngAddress.Address
        Loop While rngAddress.Address <> firstAddress
    End With
End Sub

来源：https://stackoverflow.com/questions/64426027/find-the-first-to-date-select-the-cells-under-to-date-paste-the-value-in-th