复制范围专长。一些“育儿”

Question

我有一个文件，希望宏在其中找到特定的标头，然后选择该特定列中的所有数据。此列之间有空白行。例如，我要选择产品栏（请参见屏幕截图）。

这里的挑战是我不能使用rows.count代码，因为列可能会不时更改，并且我不能使用任何特定的单元格范围来编写代码。

我也不能选择整个列，因为我需要从两个不同的选项卡中复制产品并将其粘贴到一个文件中。

有没有一种方法可以使用活动单元格编写代码并从上到下选择范围？

Sheets("PB").Select
Cells.Find(What:="product").Select
ActiveCell.Offset(1, 0).Select

Answer 1

好吧，您可以获得填充的最后一行的行号（无论是否更改，每次运行sub都将获得该列的最后一行）。

lastRow = worksheets("PB").cells(rows.count,7).end(xlup).row

然后您可以将范围设置为：

set myRange = worksheets("PB").range("B1:B" & lastRow )

Answer 2

您的代码是一个很好的开始，并且您已经说过，您只需要以可靠的方式选择行数即可。

获得我们将要挖掘的空白范围：

Set rngTopCell = Range(ActiveCell.Offset(1, 0)
Set rngBottomCell = ActiveCell.Offset(ActiveCell.CurrentRegion.Rows.Count, 0)
Set rngProductColumn = Range(rngTopCell, rngBottomCell)

然后获得该范围内的空白：

Set rngProductBlanks = rngProductColumn.SpecialCells(xlCellTypeBlanks)

这种方法避免了对特定列的依赖。

Answer 3

除非您知道已找到该单元格，否则请不要尝试选择它。
此代码将在第1行中搜索标题，然后选择其下方的数据（将Rows(1)更改为Cells以搜索整个工作表）。

Sub Test()

    Dim MyData As Range

    'Ask the function to return the column headed "product"
    Set MyData = Return_Data("product")

    If MyData Is Nothing Then
        MsgBox "Column is empty."
    Else
        MsgBox MyData.Address
        MyData.Select
    End If

End Sub

Public Function Return_Data(Heading As String) As Range

    Dim rCol As Range
    'Dim rDataRange As Range
    Dim rLastCell As Range

    With ThisWorkbook.Worksheets("PB")
        'Look for the column header.
        Set rCol = ThisWorkbook.Worksheets("PB").Cells.Find( _
            What:=Heading, After:=.Cells.Cells(1), _
            LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, _
            SearchDirection:=xlNext, MatchCase:=False)

        If Not rCol Is Nothing Then

            'Set rLastCell = .Cells(.Rows.Count, rCol.Column).End(xlUp) 'Find last row in "product" column.
            Set rLastCell = .Cells(.Rows.Count, 6).End(xlUp) 'Find last row in column 6 (F).

            If rLastCell.Row >= 2 Then
                'If the last cell is below the header than the column had data.
                'Set reference to one cell below the header down to the last cell.

                'Set Return_Data = .Range(rCol.Offset(1), rLastCell) 'If using last row in "product" column.
                Set Return_Data = .Range(rCol.Offset(1), .Cells(rLastCell.Row, rCol.Column)) 'If using last row in column 6.
            Else
                'Otherwise it's an empty column.
                Set Return_Data = Nothing
            End If
        End If
    End With

End Function

我添加了代码以在“产品”列中找到最后一行，或者在最后一行中使用“部门”列。

Answer 4

复制范围专长。一些“育儿”

Option Explicit

Sub ColumnWithBlanks()

  Const cVntWsName As Variant = "PB"      ' Worksheet Name or Index ("PB" or 1)
  Const cLngHeaderRow As String = 1       ' Header Row
  Const cStrLast As String = "Dept"       ' Last Row Column Header
  Const cStrSource As String = "Product"  ' Source Column Header

  Dim rngLast As Range                    ' Last Row Column (Range)
  Dim rngSource As Range                  ' Source Column, Source Range

  With ThisWorkbook.Sheets(cVntWsName)

    ' Find first (header) cell in Last Row Column
    Set rngLast = .Rows(cLngHeaderRow).Find(What:=cStrLast, _
        After:=.Cells(cLngHeaderRow, Columns.Count), LookIn:=xlFormulas, _
        Lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)

    ' Find first (header) cell in Source Column
    Set rngSource = .Rows(cLngHeaderRow).Find(What:=cStrSource, _
        After:=.Cells(.Rows(cLngHeaderRow), Columns.Count), _
        LookIn:=xlFormulas, Lookat:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext)

    ' Find last non-empty cell in Last Row Column
    Set rngLast = rngLast.Resize(Rows.Count - rngLast.Row + 1, 1) _
        .Find(What:="*", After:=rngLast.Cells(1, 1), LookIn:=xlFormulas, _
        Lookat:=xlWhole, SearchOrder:=xlByColumns, _
        SearchDirection:=xlPrevious) _
        .Offset(0, rngSource.Column - rngLast.Column)

    ' Calculate Source Range
    Set rngSource = .Range(rngSource.Offset(1, 0), rngLast)

    Set rngLast = Nothing

  End With

  Debug.Print rngSource.Address

  ' To refer to this worksheet you can use "rngSource.Parent" e.g.:
  Debug.Print rngSource.Parent.Name

  ' To refer to this workbook you can use "rngSource.Parent.Parent" e.g.:
  Debug.Print rngSource.Parent.Parent.Name

  ' To refer to another worksheet in this workbook you can use e.g.
  ' "rngSource.Parent.Parent.Worksheets("Sheet2")"
  Debug.Print rngSource.Parent.Parent.Worksheets("Sheet2").Name

  ' To copy the range to another range in this worksheet e.g.:
'  rngSource.Copy rngSource.Parent.Range("A1")

  Set rngSource = Nothing

End Sub

选择具有空白行的列，但没有特定的单元格范围

4 个答案:

复制范围专长。一些“育儿”