Как получить значение видимой ячейки в таблице после фильтрации? - PullRequest
0 голосов
/ 03 ноября 2018

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

Код пока:

Sub StatusFilter()

Set WB = ThisWorkbook
Set iFace = WB.Sheets("Interface")
Set DataS = WB.Sheets("Data")

iCriteria = iFace.Range("Q22").Value
DataS.Activate
ActiveSheet.ListObjects("Data").Range.AutoFilter 14, iCriteria

ActiveSheet.ListObjects("Data").DataBodyRange.Select

With Columns("A")
    .Find(what:="*", after:=.Cells(1, 1), LookIn:=xlValues).Activate
End With
DValue = ActiveCell.Value

If DValue = "" Then
    MsgBox "Lucky! No Tickets are in this Criteria!!", vbInformation, "Technology Issue Tracker"
    Exit Sub
End If

End Sub

Ответы [ 2 ]

0 голосов
/ 04 ноября 2018
Function getFirstVisibleCellInTable(tblName As String) As Range

Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects(tblName)

For i = 1 To tbl.ListRows.Count
    If False = tbl.ListRows(i).Range.EntireRow.Hidden Then
        Set getFirstVisibleCellInTable = tbl.DataBodyRange(i, 1)
        Exit Function
    End If
Next i

getFirstVisibleCellInTable = Nothing

End Function

Используйте это так:

getFirstVisibleCellInTable("Data")

Только для извлечения значения:

    getFirstVisibleCellInTable("Data").Value

только для получения адреса:

getFirstVisibleCellInTable("Data").Address
0 голосов
/ 03 ноября 2018

С вашим кодом вы должны инициализировать свои переменные.

Примерно так должно работать (следствие - это не проверено)

Sub StatusFilter()

    Dim WB As Workbook: Set WB = ThisWorkbook
    Dim iFace As Worksheet: Set iFace = WB.Sheets("Interface")
    Dim DataS As Worksheet: Set DataS = WB.Sheets("Data")

    Dim iCriteria As String: iCriteria = iFace.Range("Q22")
    Dim DValue As String

    With DataS.ListObjects("Data").Range
        .AutoFilter 14, iCriteria
        DValue = Index(.SpecialCells(xlCellTypeVisible), 1).Value
    End With

    If DValue = "" Then
        MsgBox "Lucky! No Tickets are in this Criteria!!", vbInformation, "Technology Issue Tracker"
        Exit Sub
    End If

End Sub
...