Warning: file_get_contents(/data/phpspider/zhask/data//catemap/0/vba/15.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Vba 基于搜索将行数据复制到单独的工作表_Vba_Excel - Fatal编程技术网

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

Vba 基于搜索将行数据复制到单独的工作表,vba,excel,Vba,Excel,我在Sheet1中导出了一个巨大的数据库(11K行)。记录标识符位于CQ列中 我有一个记录标识符的小列表(60-100),仅在表2的a列中 我已经找到了下面的宏,并在搜索该站点2天后对其进行了一些小的修改。此解决方案部分有效。 它将返回第一行,但不会继续向下推进数据列。当我一步一步通过时,它似乎只是不断地循环宏 这是现在的宏 Sub SearchForString() Dim LCopyToRow As Integer On Error GoTo Err_Execute

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

我有一个记录标识符的小列表(60-100),仅在表2的a列中

我已经找到了下面的宏,并在搜索该站点2天后对其进行了一些小的修改。此解决方案部分有效。

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

这是现在的宏

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

您始终可以使用下面给出的代码查找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

我该在哪里补充呢?我已经在几个地方添加了它,宏的结果没有任何变化。我们会很快回复您。Sandesh:)嗨,你能发布一个样本数据吗。我试着运行你的代码,当进度发生时,它会移到下一行。Sandesh:)你能发布为你工作的完整宏吗?当我加入你的建议时,没有什么不同。也许我遗漏了什么。你能更新一个样本数据吗。不是精确的,修改过的,但与需要实现的相似。