выбор столбца с пустыми строками без определенного диапазона ячеек

Question

У меня есть файл, в котором я хочу, чтобы мой макрос нашел конкретный заголовок и затем выделил все данные в этом конкретном столбце.Этот столбец содержит пустые строки между ними.Например, я хочу выбрать столбец продукта (см. Снимок экрана).

Проблема в том, что я не могу использовать код rows.count, потому что столбец может время от времени меняться, и я не могу использовать любойопределенный диапазон ячеек для написания моего кода.

Я также не могу выделить весь столбец, потому что мне нужно скопировать продукт из двух разных вкладок и вставить его в один файл.

Есть ли способ, которым я могуМожно написать код с использованием активной ячейки и выбрать диапазон сверху вниз?

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

Answer 1

Copy Range feat.немного «Воспитание»

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

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

Я добавил код, чтобы найти последнюю строку в столбце «Продукт» или использовать столбец «Dept» для последней строки.

Answer 4

ну, вы можете получить номер строки последней заполненной строки (независимо от того, изменяется ли она, каждый раз, когда вы запускаете подпрограмму, она получает последнюю строку столбца).

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

затемВы можете установить диапазон как:

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