VBA运行时错误1004 Range类的AutoFilter方法失败
我希望你能帮上忙。 我得到错误运行时错误1004自动过滤方法的范围类失败
当我运行我的代码Public Sub TestThis() ，有趣的是它本身是完美的，但是当我把它放入其他代码并调用它时，它会给出错误1004 AutoFilter方法的Range类失败
错误发生在这条线上
.Range("A:K").AutoFilter Field:=11, Criteria1:="<>", Operator:=xlFilterValues
就像我说的那样，当调用它时，没有被调用，运行本身没有问题。 任何帮助将不胜感激。
我的代码如下。
Sub Open_Workbook_Dialog() Dim my_FileName As Variant Dim my_Workbook As Workbook MsgBox "Pick your CRO file" '<--| txt box for prompt to pick a file my_FileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*") '<--| Opens the file window to allow selection If my_FileName <> False Then Set my_Workbook = Workbooks.Open(Filename:=my_FileName) Call TestThis Call Filter(my_Workbook) '<--|Calls the Filter Code and executes End If End Sub Public Sub Filter(my_Workbook As Workbook) Dim rCountry As Range, helpCol As Range Dim wb As Workbook With my_Workbook.Sheets(1) '<--| refer to data worksheet With .UsedRange Set helpCol = .Resize(1, 1).Offset(, .Columns.Count) '<--| get a "helper" column just at the right of used range, it'll be used to store unique country names in End With With .Range("A1:Y" & .Cells(.Rows.Count, 1).End(xlUp).Row) '<--| refer to its columns "A:Y" from row 1 to last non empty row of column "A" .Columns(11).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=helpCol, Unique:=True '<-- call AdvancedFilter on 11th column of the referenced range and store its unique values in "helper" column Set helpCol = Range(helpCol.Offset(1), helpCol.End(xlDown)) '<--| set range with unique names in (skip header row) For Each rCountry In helpCol '<--| iterate over unique country names range (skip header row) .AutoFilter 11, rCountry.Value2 '<--| filter data on country field (11th column) with current unique country name If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then '<--| if any cell other than header ones has been filtered... Set wb = Application.Workbooks.Add '<--... add new Workbook wb.SaveAs Filename:=rCountry.Value2 '<--... saves the workbook after the country .SpecialCells(xlCellTypeVisible).Copy wb.Sheets(1).Range("A1") ActiveSheet.Name = rCountry.Value2 '<--... rename it .SpecialCells(xlCellTypeVisible).Copy ActiveSheet.Range("A1") 'copy data for country under header Sheets(1).Range("A1:Y1").WrapText = False 'Takes the wrap text off ActiveWindow.Zoom = 55 Sheets(1).UsedRange.Columns.AutoFit 'Autofits the column wb.Close SaveChanges:=True '<--... saves and closes workbook End If Next End With .AutoFilterMode = False '<--| remove autofilter and show all rows back End With helpCol.Offset(-1).End(xlDown).Clear '<--| clear helper column (header included) End Sub Public Sub TestThis() Dim wks As Worksheet Set wks = ThisWorkbook.Sheets(1) With wks .AutoFilterMode = False .Range("A:K").AutoFilter Field:=11, Criteria1:="<>", Operator:=xlFilterValues .Range("A:C").SpecialCells(xlCellTypeBlanks).Interior.Color = 65535 .AutoFilterMode = False End With End Sub
请检查Set wks = ThisWorkbook.Sheets(1)是否从所需的工作簿中为您提供了所需表单。 ThisWorkbook. 语句是指放置macros（VBA项目）的工作簿。 也许你需要改变它
Set wks = ActiveWorkbook.Sheets(1)
或将my_Workbook传递给TestThis()macros。