Получить ячейку после фильтрации данных

Question

У меня простая проблема с моим макросом, мне нужно получить первую ячейку после фильтрации данных. Мой заголовок в Excel находится в Row 4, а данные в Row 5, что A5.

Теперь, когда я фильтрую данные используя мои критерии, он покажет что-то вроде этого:

A5 теперь скрыто, а новое - A13433. Как получить я могу получить клетку A13433 динамически. Поскольку у меня есть этот код, копирование отфильтрованных данных на другой лист. Да, это работает, но когда ячейка A5 меняется. Это вызывает отладочное сообщение.

 wsCopyQuery.Range("A5:U" & lDestRowDCB).SpecialCells(xlCellTypeVisible).Copy Destination:=wsDest.Range("A" & lDestRow)

Как вы можете видеть в моем коде A5:... is stati c, и я хочу динамически c этот диапазон, как-то так,

Dim getFilteredCell As Long
getFilteredCell = 'Code to get the filtered cell. For ex. "A13433"
wsCopyQuery.Range("A" & getFilteredCell & ":U" & lDestRowDCB).SpecialCells(xlCellTypeVisible).Copy Destination:=wsDest.Range("A" & lDestRow)

Что-то в этом роде, есть идеи? Спасибо!

Answer 1

Следующее устанавливает переменную R в отфильтрованный диапазон, поэтому может скопировать ее в другое место:

'Note that you hard code your first possible table row (hidden or not), and your first possible table column.
' It does assume that the rightmost cell of the first row has data. If that is not the case
' more information about your data setup would be needed.

Option Explicit
Sub due()
    Dim R As Range
    Dim wsCopyQuery As Worksheet: Set wsCopyQuery = Worksheets("Sheet3")
    Dim lLastRow As Long, lLastCol As Long
    Const lFirstRow As Long = 5
    Const lFirstCol As Long = 1

With wsCopyQuery
    lLastRow = .Cells(.Rows.Count, lFirstCol).End(xlUp).Row
    lLastCol = .Cells(lFirstRow, .Columns.Count).End(xlToLeft).Column
    Set R = .Range(.Cells(lFirstRow, lFirstCol), .Cells(lLastRow, lLastCol))
End With

'Debug.Print R.Address

Set R = R.SpecialCells(xlCellTypeVisible)
Debug.Print R.Address

End Sub

Answer 2

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

Sub testFirstCelFilteredRange()
  Dim wsCopyQuery As Worksheet, wsDest As Worksheet, rng As Range
  Dim lDestRow As Long, lDestRowDCB As Long

   Set wsCopyQuery = ActiveSheet          ' use here your apropriate sheet
   Set wsDest = Worksheets("Destination") 'please, use here your sheet
   lDestRowDCB = wsCopyQuery.Range("A" & Rows.count).End(xlUp).Row
   lDestRow = wsDest.Range("A" & Rows.count).End(xlUp).Row + 1 

   Set rng = wsCopyQuery.Range("A4:U" & lDestRowDCB).SpecialCells(xlCellTypeVisible)

   Dim LastFilteredAreaAddress As String
   Debug.Print GetFirstFiltAddress(rng).Address' you can check here the first calculated cell of the range co be copied
   LastFilteredAreaAddress = rng.Areas(rng.Areas.count).Cells(rng.Areas(rng.Areas.count).Rows.count, _
                                            rng.Areas(rng.Areas.count).Columns.count).Address
   wsCopyQuery.Range(GetFirstFiltAddress(rng).Address & ":" & _
            LastFilteredAreaAddress).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("A" & lDestRow)
End Sub

И эта функция возвращает адрес первой отфильтрованной ячейки, кроме заголовка отфильтрованной области:

Private Function GetFirstFiltAddress(fRng As Range) As Range
    Dim arrCount As Long, nRows As Long
    Const secRow As Long = 2
    Const firstCol As Long = 1
    With fRng
        Do
            arrCount = arrCount + 1
            nRows = nRows + .Areas(arrCount).Rows.count
        Loop While secRow > nRows And arrCount < .Areas.count

        If arrCount <= .Areas.count Then
            With .Areas(arrCount)
                If firstCol <= .Columns.count Then
                   Set GetFirstFiltAddress = .Item(firstCol)
                End If
            End With
        End If
    End With
End Function

Пожалуйста, подтвердите, что это делает ( Я понял) тебе нужно ...