将基于搜索的行数据复制到单独的工作表

时间:2013-12-05 16:04:19

标签: excel vba excel-vba

我在Sheet1(11K行)中导出了一个巨大的数据库。记录标识符在CQ列中。

我只在Sheet2,A列中有一个小列表(60-100)的记录标识符。

我找到了以下宏,并在搜索此网站2天后对其进行了一些小修改。该解决方案部分工作。 Find Value on other sheet and copy entire row

它将返回第一行,但不会继续向下推进数据列。当我单步执行时,它似乎只是不断循环宏。

这是现在的宏......

Sub SearchForString()

    Dim LCopyToRow As Integer


    On Error GoTo Err_Execute


    'Start copying data to row 2 in Sheet2 (row counter variable)
    LCopyToRow = 1

    Dim sheetTarget As String: sheetTarget = "sheet2"
    Dim sheetToSearch As String: sheetToSearch = "sheet1"
    Dim targetValue As String: targetValue = Sheets(sheetTarget).Range("A1").Value  'Value in sheet2!A1 to be searched in sheet1
    Dim columnToSearch As String: columnToSearch = "CQ"
    Dim iniRowToSearch As Integer: iniRowToSearch = 1
    Dim LSearchRow As Long 'As far as it is not clear the number of rows you will be considering, better relying on the long type
    Dim maxRowToSearch As Long: maxRowToSearch = 12000 'There are lots of rows, so better setting a max. limit

    If (Not IsEmpty(targetValue)) Then
        For LSearchRow = iniRowToSearch To Sheets(sheetToSearch).Rows.Count

            'If value in the current row (in columnToSearch in sheetToSearch) equals targetValue, copy entire row to LCopyToRow in sheetTarget
            If Sheets(sheetToSearch).Range(columnToSearch & CStr(LSearchRow)).Value = targetValue Then

                'Select row in Sheet1 to copy
                Sheets(sheetToSearch).Rows(LSearchRow).Copy

                'Paste row into Sheet2 in next row
                Sheets(sheetTarget).Rows(LCopyToRow).PasteSpecial Paste:=xlPasteValues

                'Move counter to next row
                LCopyToRow = LCopyToRow + 1
            End If

            If (LSearchRow >= maxRowToSearch) Then
                Exit For
            End If

        Next LSearchRow

        'Position on cell A3
        Application.CutCopyMode = False
        Range("A3").Select

        MsgBox "All matching data has been copied."
    End If

    Exit Sub

1 个答案:

答案 0 :(得分:0)

您始终可以使用下面给出的代码来查找sheet1和sheet2的最后更新行。

以下是代码。

Sub Testing()
    'for getting the last row udpated, you have to enter the max range reference
    'in our case it is A1048576.  It starts from last and check what is our last
    'row with data in specific to column A.

    'Same can be used for colu
    a = Sheet1.Range("A1048576").End(xlUp).Row
End Sub

我还建议您在代码中给出以下代码行的上述代码。

For LSearchRow = iniRowToSearch To Sheets(sheetToSearch).Rows.Count