search直到Excel VBA中的最后一行

我正在运行一个macros，我想search，直到最后一行的数据 。 目前我已经定义了最后一行1555 。 如果有超过1555行，这不是很有效。 哪种方法是最好的方法呢？ 选项显式

Sub FindValues() Dim LSearchRow As Integer Dim rw As Integer, cl As Range, LSearchValue As Long, LCopyToRow As Integer Dim LSearchString As String Dim iHowMany As Integer Dim aSearch(15) As Long Dim i As Integer 'On Error GoTo Err_Execute Sheet2.Cells.Clear Sheet1.Select iHowMany = 0 LSearchValue = 99 'this for the end user to input the required A/C to be searched Do While True LSearchString = InputBox( _ "Please enter a value to search for. " & _ "Enter a zero to indicate finished entry", _ "Enter Search value") If IsNumeric(LSearchString) Then LSearchValue = CLng(LSearchString) If LSearchValue = 0 Then Exit Do iHowMany = iHowMany + 1 If iHowMany > 15 Then MsgBox "You are limited to 15 search numbers.", vbOKOnly, "Limit reached" iHowMany = 15 Exit Do End If aSearch(iHowMany) = LSearchValue End If Loop If iHowMany = 0 Then MsgBox "No selections entered.", vbOKOnly + vbCritical, "No Search data" Exit Sub End If LCopyToRow = 2 For rw = 1 To 1555 For Each cl In Range("A" & rw & ":N" & rw) '------------------------------------------------ For i = 1 To iHowMany Debug.Print cl.Row & vbTab & cl.Column LSearchValue = aSearch(i) If cl = LSearchValue Then cl.EntireRow.Copy 'Destination:=Worksheets("Sheet2") '.Rows(LCopyToRow & ":" & LCopyToRow) Sheets("Sheet2").Select Rows(LCopyToRow & ":" & LCopyToRow).Select 'Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False 'Move counter to next row LCopyToRow = LCopyToRow + 1 'Go back to Sheet1 to continue searching Sheets("Sheet1").Select End If Next i 'LSearchRow = LSearchRow + 1 Next cl Next rw 'Position on cell A3 'Application.CutCopyMode = False 'Selection.Copy Sheets("Sheet2").Select Cells.Select 'Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ 'SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False Sheet2.Select MsgBox "All matching data has been copied." Exit Sub 'Err_Execute: MsgBox "An error occurred: " & Err.Number & vbTab & Err.Description Exit Sub Resume Next End Sub 

Answer 1

你可以使用Do Until 。 我附上了一个例子，其中列A的所有行

 'Select cell A1, *first line of data*. Range("A1").Select 'Set Do loop to stop when an empty cell is reached. Do Until IsEmpty(ActiveCell) ' Do something here ' Step down 1 row from present location. ActiveCell.Offset(1, 0).Select Loop 

Answer 2

 Dim LastRow As Long LastRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row