Question

我想请求您帮助完成以下任务。

我有源数据：，没有与表格对齐。我需要找到一个文本（标题 - 例如Toimipiste ja uuni）和行（列 - B，C，D，E，F），它们位于搜索到的单元格下面（Toimipiste ja uuni）并粘贴它们不同的表。然后向下搜索并再次执行，直到包含数据的页面结束，并且数据应按时间顺序粘贴到达。

我已经有了正确完成工作的代码，但只有在标题下方才能复制2行（或要复制的静态行数）。

代码，到目前为止我所拥有的是：

Private Sub Search_FJ()
    Dim ws As Worksheet
    Dim rngCopy As Range, aCell As Range, bcell As Range
    Dim strSearch As String

    strSearch = "Toimipiste ja uuni"

    Set ws = Worksheets("INPUT_2")

    With ws
        Set aCell = .Columns(2).Find(What:=strSearch, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

        If Not aCell Is Nothing Then
            Set bcell = aCell

            If rngCopy Is Nothing Then
                Set rngCopy = .Range(.Cells(aCell.Row + 1, 2), .Cells(aCell.Row + 2, 6))
            Else
                Set rngCopy = Union(rngCopy, .Range(.Cells(aCell.Row + 1, 2), .Cells(aCell.Row + 2, 6)))
            End If

            Do
                Set aCell = .Columns(2).FindNext(After:=aCell)

                If Not aCell Is Nothing Then
                    If aCell.Address = bcell.Address Then Exit Do

                    If rngCopy Is Nothing Then
                        Set rngCopy = .Range(.Cells(aCell.Row + 1, 2), .Cells(aCell.Row + 2, 6))
                    Else
                        Set rngCopy = Union(rngCopy, .Range(.Cells(aCell.Row + 1, 2), .Cells(aCell.Row + 2, 6)))
                    End If
                Else
                    Exit Do
                End If
            Loop
        Else
            MsgBox SearchString & "NOT FOUND"
        End If

        '~~> I am pasting to Output sheet. Change as applicable
        If Not rngCopy Is Nothing Then rngCopy.Copy Sheets("OUTPUT_2").Cells(2, 6)
    End With
End Sub

我不知道，如何纠正代码，它会考虑到，标题下方有时可能有2行，有时是4行，......我需要将它们全部复制。它总是以空行结束，如下面的屏幕所示：

我正在努力的路线是：

Set rngCopy = .Range(.Cells(aCell.Row + 1, 1), .Cells(aCell.Row + 2, 7))

由于该部件将复制2行（始终）。我想应该有内部.find函数，它将搜索标题（首先），然后搜索空单元格（第二个），但不知道，如何做到这一点。

非常感谢！

Answer 1

因此，您需要复制一系列单元格，从特定单元格开始并一直到最后一个包含数据的单元格？ This article涵盖了这项任务，应该给你一个良好的开端。

如果您遇到代码中的特定行，请随时再次询问。

编辑：根据您的修改更新了链接。 .Select语句纯粹用于展示，不应保留在代码的最终版本中。

VBA - 在表中找到特定值并复制下面的数据，直到找到空单元格（内部.find函数）

1 个答案: