Question

我正在运行一个宏，我希望搜索到最后一行数据。目前我已将最后一行定义为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

搜索直到Excel VBA中的最后一行

2 个答案: