VBA 运行时错误 1004 Range 类的 AutoFilter 方法失败
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow
原文地址: http://stackoverflow.com/questions/40483590/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA Run Time Error 1004 AutoFilter method of Range class Failed
提问by Philip Connell
I hope you can help. I am getting the error Run Time Error 1004 AutoFilter method of Range class Failed
我希望你能帮忙。我收到错误 Run Time Error 1004 AutoFilter method of Range class Failed
When I run my code Public Sub TestThis()
, the funny thing is It works perfectly by itself, but when I put it into the other code and call it, it gives the error Run Time Error 1004 AutoFilter method of Range class Failed
当我运行我的代码时Public Sub TestThis()
,有趣的是它本身可以完美运行,但是当我将它放入其他代码并调用它时,它给出了错误 Run Time Error 1004 AutoFilter method of Range class Failed
The error is happening on this line
错误发生在这一行
.Range("A:K").AutoFilter Field:=11, Criteria1:="<>", Operator:=xlFilterValues
Like I said when not called and run by itself no problem when called it bugs. Any help would be greatly appreciated.
就像我说的,当不调用它时,它本身运行没有问题,当它被称为错误时。任何帮助将不胜感激。
My code is below.
我的代码如下。
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
采纳答案by Limak
Please check if Set wks = ThisWorkbook.Sheets(1)
gives you the sheet you want, from the workbook you want. ThisWorkbook.
statement refers to workbook, where macro (VBA project) is placed. Maybe you need change it to
请检查是否从您想要的工作簿中Set wks = ThisWorkbook.Sheets(1)
为您提供了您想要的工作表。ThisWorkbook.
语句指的是工作簿,其中放置了宏(VBA 项目)。也许你需要把它改成
Set wks = ActiveWorkbook.Sheets(1)
or pass my_Workbook
to TestThis()
macro.
或传递my_Workbook
给 TestThis()
宏。