我有2本工作簿，Book_1和Book_2。
我编写了一个宏来执行过滤功能。
Sub filter_5PKT_rows()
Dim My_Range As Range
Dim CalcMode As Long
Dim ViewMode As Long
'Set filter range on ActiveSheet: A1 is the top left cell of the filter range
'and the header of the first column, L is the last column in the filter range.
'can also add the sheet name to the code like this
Set My_Range = Range("A1:L" & LastRow(ActiveSheet))
' select my range
My_Range.Parent.Select
If ActiveWorkbook.ProtectStructure = True Or _
My_Range.Parent.ProtectContents = True Then
MsgBox "Sorry, not working when the workbook or worksheet is protected", _
vbOKOnly, "Copy to new worksheet"
Exit Sub
End If
'Change ScreenUpdating, Calculation, EnableEvents, ....
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False
'Firstly, remove the AutoFilter
My_Range.Parent.AutoFilterMode = False
' My_Range.AutoFilter Field:=4, Criteria1:="=5PKT Men's"
My_Range.AutoFilter Field:=4, Criteria1:=Array("5PKT Men's", "5PKT Women's", "5PKT Short"), Operator:=xlFilterValues
' subline and cs(commercial sample) line have no connection to pocket setter
' therefore need to filter out these lines
My_Range.AutoFilter Field:=1, Criteria1:=Array("Band 01", "Band 02", "Band 03", "Band 04", "Band 05", "Band 06", "Band 07", "Band 08", "Band 09", "Band 10", "Band 11", "Band 12", "Band 13", "Band 14", "Band 15", "Band 16", "Band 17", "Band 18", "Band 19", "Band 20"), Operator:=xlFilterValues
' DO NOT SORT ACCORDING TO ORDER QUANTITY.
' THIS IS BECAUSE THERE ARE INSTANCES,
' WHERE THE SAME STYLE NUMBER IS BROKEN INTO SEVERAL POS EACH HAVING VARYING ORDER QUANTITIES
'Restore ScreenUpdating, Calculation, EnableEvents, ....
My_Range.Parent.Select
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
............................................... .................................
此代码可以根据我的需要运行并执行过滤。
假设我在Book_1，workheet_1中使用vba编辑器
中有行我为VBA项目Book_1插入一个模块并输入编码，
并运行宏，
然后进行过滤。
............................................... .............................
但是：此代码无法让我在Book_1工作表_1中执行过滤，
如果我从Book_2工作表_1中放置并执行宏。
我想从Book_2工作表1中的Book_A工作表1中执行过滤宏。
如何做到这一点？我如何编辑我的编码？
答案 0 :(得分：0)
试试这个：
Sub filter_5PKT1_rows()
Dim file_name As String
Dim sheet_name As String
file_name = "C:\Users\Desktop\pocket setter excel\production_plan.xlsm" 'Change to whatever file i want
sheet_name = "production_plan" 'Change to whatever sheet i want
' we set wb as a new work book sonce we have to open it
Dim wb As New Workbook
' To open and activate workbook, in this case production_plan
' it opens and activates the workbook production_plan and activates the worksheet production plan
' note: the work book has the name production_plan.xlsm and worksheet has the name production_plan
Set wb = Application.Workbooks.Open(file_name)
wb.Sheets(sheet_name).Activate
Dim My_Range As Range
Dim CalcMode As Long
Dim ViewMode As Long
'Set filter range on ActiveSheet: A1 is the top left cell of the filter range
'and the header of the first column, L is the last column in the filter range.
'can also add the sheet name to the code like this
Set My_Range = Range("A1:L" & LastRow(wb.ActiveSheet))
' select my range
My_Range.Parent.Select
If ActiveWorkbook.ProtectStructure = True Or _
My_Range.Parent.ProtectContents = True Then
MsgBox "Sorry, not working when the workbook or worksheet is protected", _
vbOKOnly, "Copy to new worksheet"
Exit Sub
End If
'Change ScreenUpdating, Calculation, EnableEvents, ....
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
wb.ActiveSheet.DisplayPageBreaks = False
'Firstly, remove the AutoFilter
My_Range.Parent.AutoFilterMode = False
' My_Range.AutoFilter Field:=4, Criteria1:="=5PKT Men's"
My_Range.AutoFilter Field:=4, Criteria1:=Array("5PKT Men's", "5PKT Women's", "5PKT Short"), Operator:=xlFilterValues
' subline and cs(commercial sample) line have no connection to pocket setter
' therefore need to filter out these lines
My_Range.AutoFilter Field:=1, Criteria1:=Array("Band 01", "Band 02", "Band 03", "Band 04", "Band 05", "Band 06", "Band 07", "Band 08", "Band 09", "Band 10", "Band 11", "Band 12", "Band 13", "Band 14", "Band 15", "Band 16", "Band 17", "Band 18", "Band 19", "Band 20"), Operator:=xlFilterValues
' DO NOT SORT ACCORDING TO ORDER QUANTITY.
' THIS IS BECAUSE THERE ARE INSTANCES,
' WHERE THE SAME STYLE NUMBER IS BROKEN INTO SEVERAL POS EACH HAVING VARYING ORDER QUANTITIES
'Restore ScreenUpdating, Calculation, EnableEvents, ....
My_Range.Parent.Select
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function