过滤后删除可见的单元格

我不知道为什么我的VBA代码不工作：

所以我试了一下这个代码，对CNHK很好用

但是，当我向下复制代码时，它停止工作

所以对于TW起（我只包括TW），我不断收到此错误消息：

“范围类的删除方法失败”

对于这部分代码：

r.Offset（1,0）.SpecialCells（xlCellTypeVisible）.EntireRow.Delete

我不太清楚为什么这是我调整的唯一部分是在每个范围。

Sub CNHK() Dim oLo As ListObject Dim r As Range Set oLo = Sheets("Data").ListObjects("Table2") Set r = oLo.AutoFilter.Range oLo.Range.AutoFilter Field:=4, Criteria1:= _ Array("AUSTRALIA", "FUKUOKA", "INDIA", "INDONESIA", "LONDON", "MALAYSIA", "NAGOYA", _ "NORTH AMERICA", "OSAKA", "PHILIPPINES", "SINGAPORE", "SOUTH AMERICA", "SOUTH KOREA" _ , "TAIWAN", "THAILAND", "TOKYO", "VIETNAM"), Operator:=xlFilterValues r.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete oLo.Range.AutoFilter Sheets(Array("Dash Fwd", "Dash Bck")).Select Sheets("Dash Fwd").Activate Rows("40:75").Select Selection.EntireRow.Hidden = True Rows("110:459").Select Selection.EntireRow.Hidden = True Rows("635:1054").Select Selection.EntireRow.Hidden = True Sheets("Dash Bck").Activate Rows("40:75").Select Selection.EntireRow.Hidden = True Rows("110:459").Select Selection.EntireRow.Hidden = True Rows("635:1054").Select Selection.EntireRow.Hidden = True Sheets("Dash Fwd").Select ActiveSheet.Protect Password:="013054", DrawingObjects:=False, Contents:=True, Scenarios:= _ False, AllowFormattingCells:=True, AllowFormattingColumns:=False, _ AllowFormattingRows:=False, AllowInsertingColumns:=True, AllowInsertingRows _ :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _ AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _ AllowUsingPivotTables:=True Range("A1").Select Sheets("Dash Bck").Select ActiveSheet.Protect Password:="013054", DrawingObjects:=False, Contents:=True, Scenarios:= _ False, AllowFormattingCells:=True, AllowFormattingColumns:=False, _ AllowFormattingRows:=False, AllowInsertingColumns:=True, AllowInsertingRows _ :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _ AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _ AllowUsingPivotTables:=True Range("A1").Select End Sub Sub TW() Dim oLo As ListObject Dim r As Range Set oLo = Sheets("Data").ListObjects("Table2") Set r = oLo.AutoFilter.Range oLo.Range.AutoFilter Field:=4, Criteria1:= _ Array("AUSTRALIA", "FUKUOKA", "INDIA", "INDONESIA", "LONDON", "MALAYSIA", "NAGOYA", _ "NORTH AMERICA", "OSAKA", "PHILIPPINES", "SINGAPORE", "SOUTH AMERICA", "SOUTH KOREA" _ , "BEIJING", "THAILAND", "TOKYO", "VIETNAM", "CHENGDU", "GUANGZHOU", "HONG KONG", "SHANGHAI"), Operator:=xlFilterValues r.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete oLo.Range.AutoFilter Sheets(Array("Dash Fwd", "Dash Bck")).Select Sheets("Dash Fwd").Activate Rows("40:110").Select Selection.EntireRow.Hidden = True Rows("145:1055").Select Selection.EntireRow.Hidden = True Sheets("Dash Bck").Activate Rows("40:110").Select Selection.EntireRow.Hidden = True Rows("145:1055").Select Selection.EntireRow.Hidden = True Sheets("Dash Fwd").Select ActiveSheet.Protect Password:="013054", DrawingObjects:=False, Contents:=True, Scenarios:= _ False, AllowFormattingCells:=True, AllowFormattingColumns:=False, _ AllowFormattingRows:=False, AllowInsertingColumns:=True, AllowInsertingRows _ :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _ AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _ AllowUsingPivotTables:=True Range("A1").Select Sheets("Dash Bck").Select ActiveSheet.Protect Password:="013054", DrawingObjects:=False, Contents:=True, Scenarios:= _ False, AllowFormattingCells:=True, AllowFormattingColumns:=False, _ AllowFormattingRows:=False, AllowInsertingColumns:=True, AllowInsertingRows _ :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _ AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _ AllowUsingPivotTables:=True Range("A1").Select End Sub 

Answer 1

可能问题是没有任何东西被过滤了。 尝试使用以下条件embedded错误代码：

 If not r is Nothing then r.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete end if 

此外，要查看是否属于这种情况， debug.print r.Address在错误前写入debug.print r.Address 。 如果没有设置，也应该是错误的。 否则，它将在即时窗口中打印地址。

Answer 2

PLeasereplace这部分

r.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete

你的代码与此

 Application.DisplayAlerts = False r.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete Application.DisplayAlerts = True 

在删除之前，您不需要调用SpecialCells，因为Delete方法只对可见的行起作用。