Макрос для очистки данных из бланка с помощью автофильтра с именем заголовка

Question

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

Я чувствую 90% кода.Я прибыл к источнику воды, но не могу пить.

Я получил ошибку для последней строки.

Ошибка 1004: сбой метода автофильтра класса Range.

Вот код:

Sub DeleteBlank()

Dim WrkS As Worksheet, LsC As Range, FsC As Range, Tab As Range
Dim LsH As Range, RNbr As Long, CNbr As Long, HdrRow As Range, FltCol As Variant


Set WrkS = Worksheets("data")

' Last cells 

Set LsC = Cells(Cells.Find(what:="*", SearchOrder:=xlRows, _
  SearchDirection:=xlPrevious, LookIn:=xlValues).row, _
  Cells.Find(what:="*", SearchOrder:=xlByColumns, _
  SearchDirection:=xlPrevious, LookIn:=xlValues).Column)

' First cells 

Set FsC = Cells(Cells.Find(what:="*", after:=LastCell, SearchOrder:=xlRows, _
  SearchDirection:=xlNext, LookIn:=xlValues).row, _
  Cells.Find(what:="*", after:=LastCell, SearchOrder:=xlByColumns, _
  SearchDirection:=xlNext, LookIn:=xlValues).Column)

FsC.Activate

RNbr = ActiveCell.row

LsC.Activate

CNbr = ActiveCell.Column

'to set the last header 

Set LsH = Cells(RNbr, CNbr)

' to set the header Row

Set HdrRow = Range(FsC, LsH)

Set Tab = WrkS.UsedRAnge  

' to get the Column name in wich i have to delete all blank 

With HdrRow

FltCol = .Find(what:="name", LookAt:=xlWhole).Column

End With

' the problem is below 
' Error 1004: AutoFilter method of Range class failed.
WrkS.Tab.AutoFilter Field:=FltCol, Criteria1:="="

End Sub

Answer 1

может быть, вы можете сократить его до этого

Option Explicit

Sub DeleteBlank()

    With Worksheets("data").UsedRange ' reference relevant worksheet "usedrange"
        With Intersect(.Rows(1).Find(what:="name", LookAt:=xlWhole).EntireColumn, .Cells) 'reference its column whose top cell content is "name"
            .AutoFilter Field:=1, Criteria1:="=" 'filter referenced column blank cells
            If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete ' if any filtered cells other than first row (header) then delete their entire row
        End With
        .Parent.AutoFilterMode = False
    End With

End Sub

Answer 2

Можете ли вы попробовать это?Я не мог объявить переменную с именем "Tab".Поскольку он уже был определен как диапазон в WrKS, вам не нужна ссылка на лист на линии AF.Также при использовании Find best для проверки найдено значение, чтобы избежать ошибок.Вы действительно должны использовать ссылки на листы везде (или активировать лист в начале).

Sub DeleteBlank()

Dim WrkS As Worksheet, LsC As Range, FsC As Range, Tab1 As Range
Dim LsH As Range, RNbr As Long, CNbr As Long, HdrRow As Range, FltCol As Variant

Set WrkS = Worksheets("data")

Set LsC = Cells.Find(what:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues)
Set FsC = Cells.Find(what:="*", after:=LastCell, SearchOrder:=xlRows, SearchDirection:=xlNext, LookIn:=xlValues)

If Not FsC Is Nothing Then
    If Not LsC Is Nothing Then
        RNbr = FsC.Row
        CNbr = LsC.Column
        Set LsH = Cells(RNbr, CNbr)
        Set HdrRow = Range(FsC, LsH)
        Set Tab1 = WrkS.UsedRange
        FltCol = HdrRow.Find(what:="name", LookAt:=xlWhole).Column
        Tab1.AutoFilter Field:=FltCol, Criteria1:="="
    End If
End If

End Sub