Excel VBA选择一系列单元格直到单元格包含特定文本

时间:2017-04-21 20:43:19

标签: excel excel-vba vba

我已经能够在工作表中搜索名称(下面代码中的Dion)并将包含名称Dion的行复制到另一个工作表。但是,目标工作表可能包含与源工作表中最后一列文本相邻的列中的文本。

我希望能够从包含Dion的行中选择一系列单元格,选择结束于包含特定文本的单元格。

我也尝试将If Cells(...).Value = "Dion" Then更改为 If Range("A1:CS1000")...但仍然遇到类型不匹配错误。

这是我的VBA代码。我知道这可能非常低效,但这是我能够做的工作:

Dim r As Long
Dim endRow As Long
Dim pasteRowIndex As Long

Worksheets("Tracking").Activate

endRow = 500
pasteRowIndex = 1

For r = 6 To endRow

    If Cells(r, Columns("BM").Column).Value = "Dion" Then

        Rows(r).Select
        'Code above shoud select all cells from Rows(r) until a cell contains the text "End"
        Selection.Copy

        Worksheets("Dion").Select
        Rows(pasteRowIndex + 5).Select
        ActiveSheet.Paste

        pasteRowIndex = pasteRowIndex + 1

        Worksheets("Tracking").Select

    End If

Next r

感谢您的帮助。

1 个答案:

答案 0 :(得分:2)

如果您只是想将行的副本限制为包含值为“End”的列,则以下代码应该有效:

Dim r As Long
Dim endRow As Long
Dim pasteRowIndex As Long
Dim endCell As Range

'Use With block so that we can write '.' instead of 'Worksheets("Tracking").'
With Worksheets("Tracking")

    endRow = 500
    pasteRowIndex = 1

    For r = 6 To endRow
        'Always qualify 'Cells', 'Range', 'Columns' and 'Rows' objects so that we
        'know what sheet we are referring to
        'Also, as pointed out by A.S.H, ' Columns("BM").Column ' can be
        'shortened to ' "BM" '
        If .Cells(r, "BM").Value = "Dion" Then
            'Find, in the current row, the location of the first cell containing "End"
            'Note: If you want to search for the word "End" by itself, rather than just
            '"End" within the cell (e.g. in the value "Endymion"), change "xlPart" to
            '"xlWhole"
            Set endCell = .Rows(r).Find(What:="End", LookIn:=xlValues, LookAt:=xlPart, After:=.Cells(r, "A"))
            If endCell Is Nothing Then
                'If no "End" found, copy the entire row
                .Rows(r).Copy Worksheets("Dion").Rows(pasteRowIndex + 5)
            Else
                'If "End" found, copy from column A to the cell containing "End"
                'Note: I have assumed you don't want to copy the "End" cell itself
                .Range(.Cells(r, "A"), endCell.Offset(0, -1)).Copy Worksheets("Dion").Rows(pasteRowIndex + 5).Cells(1, "A")
            End If

            pasteRowIndex = pasteRowIndex + 1

        End If

    Next r
End With