我试图自动过滤以删除包含值0的所有行。代码自己工作（它是底部的最后一位），但是当我将它添加到我的更大的宏时，我得到
运行时错误1004
问题似乎与行：
Set VRange = Range(ActiveSheet.Range("b1"), ActiveSheet.Range("b1").End(xlDown))
但我无法弄清楚如何改变它仍然实现我想要的（并保持简单，所以我可以将其重用于其他工作表，而无需多次更改/指定工作表名称）
任何帮助将不胜感激 - 我被困住了。多谢你们！
Sub Test()
Sheets("Sheet1").Activate
' Add a heading to the “GL” column
Range("C2").Select
ActiveCell.FormulaR1C1 = "GL"
'Create new worksheets for each heading (with heading names)
Dim xRg As Excel.Range
Dim wSh As Excel.Worksheet
Dim wBk As Excel.Workbook
Set wSh = ActiveSheet
Set wBk = ActiveWorkbook
Application.ScreenUpdating = False
For Each xRg In wSh.Range("D2:P2")
With wBk
.Sheets.Add after:=.Sheets(.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = xRg.Value
If Err.Number = 1004 Then
Debug.Print xRg.Value & " already used as a sheet name"
End If
On Error GoTo 0
End With
Next xRg
'Copies the master sheet values into new worksheet called “Test”
'(that was created with the code above based on the header name in row 2),
' and deletes inapplicable columns
Sheets("Sheet1").Activate
ActiveSheet.UsedRange.Copy
Sheets("Test").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Test").Range("A1").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value = "Test" _
Or ActiveCell.Value = "GL" Then
ActiveCell.Offset(0, 1).Select
Else
ActiveCell.EntireColumn.Select
Selection.Delete Shift:=xlToLeft
Selection.End(xlUp).Select
End If
Loop
' THIS CODE DOESN'T WORK WITH REST OF MACRO BUT WORKS ON ITS OWN
' Removes 0 values and total row
Sheets("Test").Activate
Dim VRange As Range
Set VRange = Range(ActiveSheet.Range("b1"), ActiveSheet.Range("b1").End(xlDown))
With VRange
.AutoFilter
.AutoFilter field:=1, Criteria1:="0"
.Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.AutoFilter
End With
On Error Resume Next
Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True
End Sub
代码可以单独工作（这是底部的最后一点），但是当我将它添加到我的更大的宏时，......
那是因为你的更大的宏在“独立”代码之前做了一些事情，后者不知道，因此无法处理
例如
Sheets("Sheet1").Activate
ActiveSheet.UsedRange.Copy
Sheets("Test").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Test").Range("A1").Select
正在复制“Sheet1”UsedRange并从单元格A1开始粘贴到“测试”表
因此，你在很大程度上依赖于“Sheet1”表的实际“结构”，即你假设它的UsedRange将在一些众所周知的（仅限你）细胞的右上角Do Until ... Loop循环正在删除与从A1开始的第一个行单元格内容相关的“测试”工作表列
如果没有具有“测试”或“GL”内容的单元格，则所有“测试”表单相关（即第1行中没有空单元格）列将被删除！Set VRange = Range(ActiveSheet.Range("b1"), ActiveSheet.Range("b1").End(xlDown))可以很好地参考“测试”表整空列B！最后，为了真正帮助您，您应该使用可能的“Sheet1”数据“结构”处理来增强您的代码（以及您的帖子）
而且，考虑放弃所有Select/Activate/Selection/ActiveXXX编码模式，因为它会让你快速失去对你的代码实际做什么的控制
为了帮助您重构代码，您可以考虑以下内容（注释中的解释）：
Sub Test()
Dim xRg As Range
With Sheets("Sheet1") 'reference "Sheet1" sheet
.Range("C2").Value = "GL" ' Add “GL” column heading to referenced sheet "C2" cell
'Create new worksheets for each heading (with heading names)
With .Range("D2:P2") 'reference referenced sheet range "D2:P2"
Select Case True
Case WorksheetFunction.CountA(.Cells) = 0 'if only empty cells in referenced range
MsgBox "no values in " & .Address(False, False)
Exit Sub
Case .Find("test", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False) Is Nothing
If Not IsSheetAlreadyThere("Test") Then
MsgBox "no 'Test' sheet neither in " & .Address(False, False) & " nor already in " & ActiveWorkbook.Name & " workbook"
Exit Sub
Else
Sheets("Test").UsedRange.ClearContents
End If
End Select
For Each xRg In .SpecialCells(xlCellTypeConstants) 'loop through referenced range not empty cells only
If IsSheetAlreadyThere(xRg.Value) Then ' if current cell value matches an existent sheet name
Sheets(xRg.Value).UsedRange.ClearContents ' clear the content of the existent sheet named after current cell value
Else
On Error Resume Next ' handle possible errors due to invalid sheet names
Sheets.Add(after:=Sheets(Sheets.Count)).Name = xRg.Value 'add a new sheet and try naming it after current cell value
If Err.Number = 1004 Then ' if naming new sheet failed
Debug.Print "Name '" & xRg.Value & "' not a valid worksheet name"
Application.DisplayAlerts = False
ActiveSheet.Delete 'deelete new sheet
Application.DisplayAlerts = True
End If
On Error GoTo 0
End If
Next
End With ' stop referencing "Sheet1" sheet rang "D2:P2"
'Copies the master ("Sheet1") sheet values into new worksheet called “Test”
'(that was created with the code above based on the header name in row 2),
' and deletes inapplicable columns
With .UsedRange 'reference referenced sheet (i.e. "Sheet1") "used" range
Sheets("Test").Range("A1").Resize(.Rows.Count, .Columns.Count).Value = .Value ' copy paste its values in "Test" sheet starting from this latter A1 cell
End With
End With ' stop referencing "Sheet1" sheet
With Sheets("Test") ' reference "Test" sheet
If WorksheetFunction.CountA(.Rows(1)) = 0 Then 'if only empty cells in reference sheet (i.e. "Test") row 1
MsgBox "no values in " & .Address(False, False)
Exit Sub
End If
Dim f As Range
Set f = .UsedRange.Cells(1, .UsedRange.Columns.Count + 1) ' set f as a "dummy" cell out of used range
For Each xRg In .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft)) 'loop through referenced sheet row 1 cells from column 1 rightwards to last not empty one
Select Case xRg.Value ' query curent cell value
Case "Test", "GL" ' if it's a "good" name then do nothing
Case Else ' if it's a "bad" name then add current cell to the ones whose entirecolumn is to be deleted
Set f = Union(f, xRg)
End Select
Next
Set f = Intersect(.UsedRange, f) ' get rid of the "dummy" cell
If Not f Is Nothing Then f.EntireColumn.Delete 'if any found cell with "bad" names then delete their entire column
With .Range("B1", .Range("b1").End(xlDown)) ' <<<< hope that there's actually some data in column "B" !!>>>>
.AutoFilter
.AutoFilter field:=1, Criteria1:="0"
.Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.AutoFilter
End With
With Intersect(.Columns("A"), .UsedRange) 'reference referenced sheet column A cells in used range (avoid considering one million rows)
MsgBox .Address
If WorksheetFunction.CountBlank(.Cells) Then .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End With ' stop referencing "Test" sheet
End Sub
Function IsSheetAlreadyThere(shtName As String) As Boolean
On Error Resume Next
IsSheetAlreadyThere = Sheets(shtName).Name = shtName
End Function
我试图自动筛选以删除包含值0的所有行
除了AutoFilter()方法，你可以使用另一个：
With Sheets("Test")
With .Range("b1", .Cells(.Rows.Count, 2).End(xlUp)) <<<< hope that there's actually some data in column "B" !!>>>>
.Replace What:=0, Replacement:="", LookAt:=xlWhole
If WorksheetFunction.CountA(.Cells) > 0 Then .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End With