这是我的第一个答案，它只是整理了您现有的代码。我所有的更改和添加都标有“引用哈希”。研究我所做的更改，并尝试了解我做出这些更改的原因。我计划两个进一步的答案。
Option Explicit '# Always include this statement at top
Sub SearchForString()
Dim LSearchRow As Long '# Integer creates 16-bit value which requires
Dim LCopyToRow As Long '# special processing on post-16-bit computers
Dim LSearchValue As String
Dim WshtSrc As Worksheet '# Faster and more convenient if you are
Dim WshtDest As Worksheet '# working with more than one worksheet
Set WshtSrc = Worksheets("Search") '# These are probably the wrong
Set WshtDest = Worksheets("Dest") '# worksheet names
'# I never use "On Error GoTo label" while developing macros because I want to
'# know where an error occurs. Before release, I check for every condition that
'# might lead to an error if possible. If I cannot stop the possibility of an
'# error, I will use "On Error Goto Next" and "On Error GoTo 0" either side of
'# a problem statement and I will then test Err. This will allows me to issue a
'# useful message to the user even if I cannot do better.
'# On Error GoTo Err_Execute
LSearchValue = InputBox("Please enter the staff ID.", "Enter value")
'Start search in row 5
LSearchRow = 6
'Start copying data to row 5 in Sheet1 (row counter variable)
LCopyToRow = 5
With WshtSrc
While Len(.Range("A" & CStr(LSearchRow)).Value) > 0 '#
'If value in column A = LSearchValue, copy entire row to Sheet1
If .Range("A" & CStr(LSearchRow)).Value = LSearchValue Then '#
.Rows(LSearchRow).Copy Destination:=WshtDest.Cells(LCopyToRow, 1)
'# 'Select row in Sheet1 to copy
'# Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
'# Selection.Copy
'# 'Paste row into Sheet1 in next row
'# Sheets("Search").Select
'# Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
'# ActiveSheet.Paste
'Move counter to next row
LCopyToRow = LCopyToRow + 1
'# 'Go back to Sheet1 to continue searching
'# Sheets("Search").Select
End If
LSearchRow = LSearchRow + 1
Wend
'Position on cell A3
'Range("A3").Select
End With
Exit Sub
'# Err_Execute:
'# MsgBox "An error occurred."
End Sub
答案 2
在LSearchValue = InputBox("Please enter the staff ID.", "Enter value")之后添加：
If LSearchValue = "" Or LSearchValue = "Enter value" Then
' User does not want to make a selection
Exit Sub
End If
WshtDest.Cells.EntireRow.Delete
'# Copy heading rows
WshtSrc.Rows("1:4").Copy Destination:=WshtDest.Range("A1")
我应该在第一个答案中包含前五行。总是给用户说：“打扰！我不是故意的”，并退出他们所做的选择。我应该在开始新的选择之前清除上一个选择的目标表。
最后一条语句是我所知道的最简单的复制四行的方法。
我注意到我的第一个答案有错误。我错过了两个必要的更改：
While Len(.Range("A" & CStr(LSearchRow)).Value) > 0
If .Range("A" & CStr(LSearchRow)).Value = LSearchValue Then
我省略了 Range 前面的句点。 Range 在活动工作表上运行。 .Range 对With 语句中指定的工作表进行操作。
答案 3
我在这个问题上做得不好，所以我就是把水壶叫黑的锅。使用 Excel 的强大功能。如果 Excel 有一个功能可以满足您的需求，请使用它。
对于我的测试数据，我有四列，我的员工 ID 是字母 A 到 D。要获得下面的宏，我：
- 打开宏记录器
- 选择了前四列
- 已选择自动筛选以将其打开
- 单击 A 列顶部的箭头并单击值 B
- 已选择自动筛选以将其关闭
- 关闭宏记录器
.
Sub Macro2()
'
' Macro2 Macro
' Macro recorded 21/05/2014 by Tony Dallimore
'
'
Columns("A:D").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="B"
Selection.AutoFilter
End Sub
在第二个 AutoFilter 语句之后，如果用户选择员工 ID B，屏幕几乎就是您想要复制的内容。“几乎完全”是因为第 2 到第 4 行是不可见的。如果有办法告诉 AutoFilter 你有四个标题行，那么我不知道，所以我会以不同的方式解决这个问题。
宏记录器不知道您的目标。这段代码在语法上是正确的，但它不是好的代码，所以必须整理一下。此外，它不会复制行，因为我已经知道该怎么做。下面的宏更小，如果你有很多行，速度会更快。
Sub SearchForString2()
Dim LSearchValue As String
Dim RngCopy As Range
Dim RngData As Range
Dim WshtSrc As Worksheet
Dim WshtDest As Worksheet
' I should have included this in answer 1. It stops the screen being repainted
' as the worksheets are changed which is both slow and irritating because of
' the flashing.
Application.ScreenUpdating = False
Set WshtSrc = Worksheets("Search") '# These are probably the wrong
Set WshtDest = Worksheets("Dest") '# worksheet names
LSearchValue = InputBox("Please enter the staff ID.", "Enter value")
WshtDest.Cells.EntireRow.ClearContents
If LSearchValue = "" Or LSearchValue = "Enter value" Then
' User does not want to make a selection
Exit Sub
End If
With WshtSrc
Set RngData = .Columns("A:D") ' Change column range as necessary
RngData.AutoFilter ' Switch AutoFilter on.
RngData.AutoFilter Field:=1, Criteria1:=LSearchValue
.Rows("2:4").Hidden = False
Set RngCopy = .Cells.SpecialCells(xlCellTypeVisible)
RngCopy.Copy Destination:=WshtDest.Range("A1")
RngData.AutoFilter ' Switch AutoFilter off.
End With
' Note that there is no period before RngData or RngCopy.
' When you set a range, the worksheet is part of the range.
' So Columns is a "child" of WshtSrc but RngData and RngCopy are not.
' The following statement shows that RngData "knows" what worksheet
'it applies to.
Debug.Print "RngData's worksheet: " & RngData.Worksheet.Name
Exit Sub
End Sub