我需要你的帮助！ ：o 目前我有一个带有宏的excel工作簿，它能够进行搜索以找到具有值的单元格并选择整行。之后它将复制＆amp;将该行粘贴到名为＆＃34;搜索＆＃34;。
的电子表格中但是，我需要改变宏来复制＆amp;在执行搜索，复制和放大之前，将固定数量的列标题行（例如第1行到第4行）粘贴到电子表格中（＆＃34;搜索＆＃34;）。粘贴到同一个电子表格中（＆＃34;搜索＆＃34;）。
有谁能告诉我怎么做？我想要么这样做（选择，复制并粘贴那么搜索，选择，复制和粘贴）或选择多个范围，例如（选择第1行到第4行以及搜索后确定的行）。
Sub SearchForString()
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Dim LSearchValue As String
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
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
'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
Application.CutCopyMode = False
Range("A3").Select
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub
答案 0 :(得分：1)
这是我的第一个答案，它只是整理您现有的代码。我的所有更改和添加都标有“引用哈希”。研究我所做的改变，并试着理解我为什么做出这些改变。我计划另外两个答案。
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.要获得下面的宏，我：
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
答案 1 :(得分：0)
您可以在搜索代码时使用此代码：
Selection.Find(What:=LSearchValue, After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
True, SearchFormat:=False).Activate
Dim valuerow As Integer
valuerow = Application.ActiveCell.Row
valuerow是找到的单元格的行索引