找到行值，複製行和下面的所有範圍以減少數據

Question

我想使用宏來清理數據文件，並且只在Sheet2上覆制最相關的東西。

我寫了代碼來查找我想要從中複製數據的行。但是，我只能複製行本身，而不是下面的範圍。請注意，由於矩陣的大小總是變化，我需要從該行到最後一列和最後一行的範圍。

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 

所以基本上下面的代碼找到第一行並將其複製到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 

Answer 1

，如果你要複製的是有「S」，一切都行你並不需要爲這個循環在它下面到目標表單。以下子查找列A中具有「s」的行，然後將該行及其下面的所有內容複製到目標工作表。

請注意，您應該始終避免選擇或激活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 

Answer 2

Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select 

所以，首先你沒有實際上可以需要CStr，VBA本身將投數爲字符串，即Range(LSearchRow & ":" & LSearchRow)應該正常工作。

要了解多少行往下走使用range對象的end功能：

bottomRow = Range("A" & LSearchRow).End(xldown).Row 

執行相同的列

lastCol = Range("A" & LSearchRow).End(xlleft).column 

現在複製：

Range("A" & LSearchRow & ":" & lastCol & bottomRow).Copy 

但是，如果您在數據的中間有空單元格，而不是使用End(xldown)，開始在紙張的底部，並期待：

bottomRow = Range("A1000000").End(xlup).Row 

等