vba 查找行值，复制行和下面的所有范围以进行数据缩减
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/17299449/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Find row value, copy row and all the range underneath for data reduction
提问by user2459002
I am trying to use a macro to clean up data files and only copy on Sheet2 what is most relevant.
我正在尝试使用宏来清理数据文件，并且只在 Sheet2 上复制最相关的内容。
I have written the code to find the row I want the data to be copied from. However I can only copy the row itself and not the range underneath. Please note I need the range to go from that row to the last column and last row as the size of the matriz always varies.
我已经编写了代码来查找要从中复制数据的行。但是我只能复制行本身而不是下面的范围。请注意，我需要从该行到最后一列和最后一行的范围，因为矩阵的大小总是变化的。
s N s N s N s N s rpm
Linear Real Linear Real Linear Real Linear Real Linear Amplitude
0.0000030 9853.66 0.0000030 5951.83 0.0000030 533.48 0.0000030 476.15 0.0000030 2150.16
0.0000226 9848.63 0.0000226 5948.19 0.0000226 557.02 0.0000226 488.60 0.0000226 2150.16
0.0000421 9826.05 0.0000421 5956.22 0.0000421 615.94 0.0000421 480.75 0.0000421 2150.15
0.0000616 9829.72 0.0000616 5989.72 0.0000616 642.59 0.0000616 476.77 0.0000616 2150.15
So basically the code below finds that first row and copies it in Sheet2. I need the macro to also select the range underneath and copy it onto Sheet2. Please can you help me finishing off the script?
所以基本上下面的代码找到第一行并将其复制到 Sheet2 中。我需要宏来选择下面的范围并将其复制到 Sheet2 上。请你能帮我完成剧本吗？
Sub SearchForRawData()
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
On Error GoTo Err_Execute
'Start search in row 1
LSearchRow = 1
'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2
While Len(Range("A" & CStr(LSearchRow)).Value) >= 0
'If value in column A = "s", copy entire row to Sheet2
If Range("A" & CStr(LSearchRow)).Value = "s" Then
'Select row and range in Sheet1 to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
'Paste row into Sheet2 in next row
Sheets("Sheet2").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste
'Select all Raw Data underneath found Row to Copy
'Paste all Raw Data into Sheet 2
'Move counter to next row
LCopyToRow = LCopyToRow + 1
'Go back to Sheet1 to continue searching
Sheets("Sheet1").Select
End If
LSearchRow = LSearchRow + 1
Wend
'Position on cell A1
Application.CutCopyMode = False
Range("A1").Select
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox "An error has occured"
End Sub
采纳答案by Jon Crowell
You don't need a loop for this if you want to copy the row that has the "s" and everything below it to the target sheet. The following sub finds the row with the "s" in column A and then copies that row and everything below it to the target sheet.
如果要将具有“s”的行及其下方的所有内容复制到目标工作表，则不需要为此循环。以下子程序在 A 列中查找带有“s”的行，然后将该行及其下方的所有内容复制到目标工作表中。
Note that you should always avoid selecting or activating anything in VBA code, and that the normal way to copy and paste relies on selecting. If you use the syntax I've included here, the clipboard is not used and the target sheet does not need to be selected.
请注意，您应该始终避免选择或激活 VBA 代码中的任何内容，并且复制和粘贴的正常方式依赖于选择。如果您使用我在此处包含的语法，则不会使用剪贴板，也无需选择目标工作表。
Sub CopyRowAndBelowToTarget()
Dim wb As Workbook
Dim src As Worksheet
Dim tgt As Worksheet
Dim match As Range
Set wb = ThisWorkbook
Set src = wb.Sheets("Sheet1")
Set tgt = wb.Sheets("Sheet2")
Dim lastCopyRow As Long
Dim lastPasteRow As Long
Dim lastCol As Long
Dim matchRow As Long
Dim findMe As String
' specify what we're searching for
findMe = "s"
' find our search string in column A (1)
Set match = src.Columns(1).Find(What:=findMe, After:=src.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
' figure out what row our search string is on
matchRow = match.Row
' get the last row and column with data so we know how much to copy
lastCopyRow = src.Range("A" & src.Rows.Count).End(xlUp).Row
lastCol = src.Cells(1, src.Columns.Count).End(xlToLeft).Column
' find out where on our target sheet we should paste the results
lastPasteRow = tgt.Range("A" & src.Rows.Count).End(xlUp).Row
' use copy/paste syntax that doesn't use the clipboard
' and doesn't select or activate
src.Range(Cells(matchRow, 1), Cells(lastCopyRow, lastCol)).Copy _
tgt.Range("A" & lastPasteRow)
End Sub
回答by Dan
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
So firstly you don't acutally need the CStr, vba will cast numbers to strings by itself, i.e. Range(LSearchRow & ":" & LSearchRow)should work fine.
所以首先你并不真正需要CStr，vba 会自己将数字转换为字符串，即Range(LSearchRow & ":" & LSearchRow)应该可以正常工作。
To find how many rows down to go use the endfunction of the rangeobject:
要查找向下移动多少行，请使用对象的end函数range：
bottomRow = Range("A" & LSearchRow).End(xldown).Row
Do the same for the column
对列执行相同操作
lastCol = Range("A" & LSearchRow).End(xlleft).column
Now to copy:
现在复制：
Range("A" & LSearchRow & ":" & lastCol & bottomRow).Copy
However if you have empty cells inthe middleof the data then instead of using End(xldown), start at the bottom of the sheet and look up:
但是，如果数据中间有空单元格，则不要使用End(xldown)，而是从工作表底部开始查找：
bottomRow = Range("A1000000").End(xlup).Row
etc
等等
