Do循环不能在用户input的查找范围上工作

任何人都可以帮我弄清楚我做错了什么？ 下面的循环来复制特定的数据行不适合我。 我试图创build一个提示，将匹配我指定的列“A”中的单元格值和我指定的列“AN”中的date。 匹配行中的整行将复制。

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

试试这与固定嵌套。

我也拿出了重复的“没有匹配的search结果”的消息（因为你不会在开始find任何东西，或者你会发现至less有一件事）。

你仍然重复第一次find两次，所以它应该进一步修改。

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

请记住，你首先做一个Find – 如果你什么也没find，你会显示一条消息，否则，你保存地址，然后你做任何你的移动逻辑，然后你FindNext ，你重复这个，直到你循环。

我想你也意味着做lastrowsheet2 = lastrowsheet2 + 1

我也从你的放置代码中取出了lastrowsheet2 - 1因为它看起来不对。

更新以searchdate并修复lastrow（最终代码）

 Sub Yo2() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual ' Use last cell in UsedRange for its row number, Dim lastrowsheet2 As Long lastrowsheet2 = ThisWorkbook.Sheets("Location File Data").UsedRange.Rows.CountLarge 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 

结果：

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