循环不用于用户输入的findrange

Question

任何人都可以帮我弄清楚我做错了什么吗？以下用于复制特定数据行的循环对我不起作用。我正在尝试创建一个提示，它将匹配我指定的列“A”中的单元格值以及我指定的列“AN”中的日期。匹配行的整行将复制。

Sub Yo2()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' Use last cell in UsedRange for its row number,
Dim lastrowsheet2 As Long
With ThisWorkbook.Sheets("Location File Data").UsedRange
    lastrowsheet2 = (Sheets("Compare").Range("D3"))
    If lastrowsheet2 = 1 And .Cells(1).Value = "" Then lastrowsheet2 = 0
End With

Dim userinput As String
userinput = InputBox("Enter a value to search for.", "Column A Search")
Dim findrange As Range
Dim firstaddress As String
Set findrange = ThisWorkbook.Sheets("Sheet1").Columns("A").Find(what:=userinput, lookat:=xlWhole, LookIn:=xlValues)
If findrange Is Nothing Then
    MsgBox "No matching search results"
Else
    firstaddress = findrange.Address
    Do
        Set findrange = ThisWorkbook.Sheets("Sheet1").Columns("AN").Find(what:=userinput, lookat:=xlWhole, LookIn:=xlValues)

        If findrange Is Nothing Then
            MsgBox "No matching search results"

        Else
            firstaddress = findrange.Address        
            lastrowsheet2 = lastrowsheet2 - 1
            ThisWorkbook.Sheets("Location File Data").Range("A" & lastrowsheet2 - 1, "AN" & lastrowsheet2 - 1).Value = ThisWorkbook.Sheets("Sheet1").Range("A" & findrange.Row, "AN" & findrange.Row).Value
            Set findrange = ThisWorkbook.Sheets("Sheet1").Columns("A").FindNext(findrange)

    ' Loop until the Find has wrapped back around, or value not found any more
    Loop While Not findrange Is Nothing And findrange.Address <>firstaddress
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Answer 1

尝试使用固定嵌套。

我还拿出了重复的“没有匹配的搜索结果”消息（因为你在开头找不到任何东西，或者你至少会发现一件事）。

你仍在重复第一次发现两次，所以应该进一步改造。

编辑也删除重复的Set findrange =语句。

请记住，你首先做一个Find - 如果你什么也没找到，你会显示一条消息就是这样，否则，你保存地址，然后你做任何移动逻辑，然后你{{{ 1}}然后你重复这个，直到你循环。

我认为你也想做FindNext

我也从您的展示位置代码中取出lastrowsheet2 = lastrowsheet2 + 1，因为它似乎不对。

更新以搜索日期并修复lastrow（最终代码）

lastrowsheet2 - 1

结果：

Answer 2

@ user1274820现在完美运行，谢谢!!!

Sub Hey()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' Use last cell in UsedRange for its row number,
Dim lastrowsheet2 As Long
lastrowsheet2 = (Sheets("Compare").Range("D3"))
If lastrowsheet2 = 1 Then lastrowsheet2 = 0
Dim userinput As String, DateInput As String
userinput = InputBox("Enter a value to search for.", "Column A Search")
DateInput = InputBox("Enter a date to search for.", "Column AN Search")
Dim findrange As Range
Dim firstaddress As String
Set findrange = ThisWorkbook.Sheets("Sheet1").Columns("A").Find(what:=userinput, lookat:=xlWhole, LookIn:=xlValues)
If findrange Is Nothing Then
MsgBox "No matching search results"
Else
firstaddress = findrange.Address
Do
    If DateValue(DateInput) = Sheets("Sheet1").Cells(findrange.Row, "AN").Value Then
        lastrowsheet2 = lastrowsheet2 + 1
        ThisWorkbook.Sheets("Location File Data").Range("A" & lastrowsheet2, "AN" & lastrowsheet2).Value = ThisWorkbook.Sheets("Sheet1").Range("A" & findrange.Row, "AN" & findrange.Row).Value
    End If
    Set findrange = ThisWorkbook.Sheets("Sheet1").Columns("A").FindNext(findrange)
    ' Loop until the Find has wrapped back around, or value not found any more
Loop While Not findrange Is Nothing And findrange.Address <> firstaddress
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub