Question

我正在尝试将多个工作表[3]从1个excel文件拆分为具有相同3个工作表的较小文件，但是每个文件的较小部分，由1个列中的值拆分[相同列标题即被过滤的是所有3张纸，但其余的数据是不同的]

我能够用1张纸来做这件事，这会为1张纸生成许多不同的文件，但我基本上将其应用于同一个自动过滤器而不会失败。我不太了解数组

下面是代码，直到它中断。请注意，第一个表是Query1，第二个表是Query2，导出条件是一个工作簿范围命名范围

Dim ArrayItem As Long
Dim ws As Worksheet
Dim ArrayOfUniqueValues As Variant
Dim SavePath As String
Dim ColumnHeadingInt As Long
Dim ColumnHeadingStr As String
Dim rng As Range
Dim MainWkbk As Workbook
Dim NextWkbk As Workbook
Dim CustomerLevelRange As Range
Dim tbl As ListObject
Dim Pt As PivotTable
Dim CurrentFilter

Set MainWkbk = ActiveWorkbook
Set ws = Sheets("Customer_Level_Detailed")
SavePath = "D:\test\"
ColumnHeadingInt = WorksheetFunction.Match(Range("ExportCriteria").Value, Range("Query1[#Headers]"), 0)
ColumnHeadingStr = "Query1[[#All],[" & Range("ExportCriteria").Value & "]]"

Application.ScreenUpdating = False
Range(ColumnHeadingStr & "").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("UniqueValues"), Unique:=True

ws.Range("UniqueValues").EntireColumn.Sort Key1:=ws.Range("UniqueValues").Offset(1, 0), _
Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

ArrayOfUniqueValues = Application.WorksheetFunction.Transpose(ws.Range("UniqueValues").EntireColumn.SpecialCells(xlCellTypeConstants))

ws.Range("UniqueValues").EntireColumn.Clear

For ArrayItem = 2 To UBound(ArrayOfUniqueValues)

Workbooks.Add
Set NextWkbk = ActiveWorkbook
ActiveSheet.Name = "Customer_Level_Detailed"

Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "Service_Level_Detailed"

'CUSTOMER_LEVEL_PASTE
MainWkbk.Activate
Sheets("Customer_Level_Detailed").Select
ws.ListObjects("Query1").Range.AutoFilter Field:=ColumnHeadingInt, Criteria1:=ArrayOfUniqueValues(ArrayItem)
ws.Range("Query1[#All]").SpecialCells(xlCellTypeVisible).Copy
NextWkbk.Activate
Sheets("Customer_Level_Detailed").Select
Range("A3").PasteSpecial xlPasteAll
Set CustomerLevelRange = Range(Range("A3"), Range("A3").SpecialCells(xlLastCell))
Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, CustomerLevelRange, , xlYes)
tbl.TableStyle = "TableStyleMedium15"

'SERVICE LEVEL PASTE
MainWkbk.Activate
Sheets("Service_Level_Detailed").Select
ColumnHeadingInt = WorksheetFunction.Match(Range("ExportCriteria").Value, Range("Query2[#Headers]"), 0)
ws.ListObjects("Query2").Range.AutoFilter Field:=ColumnHeadingInt, Criteria1:=ArrayOfUniqueValues(ArrayItem)
' ^^ THIS IS THE POINT THE FAILURE OCCURS ^^
ws.Range("Query2[#All]").SpecialCells(xlCellTypeVisible).Copy

Next ArrayItem

ws.AutoFilterMode = False
MsgBox "Finished exporting!"
Application.ScreenUpdating = True

Answer 1

它是因为您使用ws（定义为Sheets("Customer_Level_Detailed")）作为Query2表的显式工作表限定，而该表位于Service_Level_Detailed表

这胜过以前选择了想要的工作表（Sheets("Service_Level_Detailed").Select）

因此，快速而肮脏的修复方法会将所有ws次出现更改为ActiveSheet次。例如：

ws.ListObjects("Query2").Range.AutoFilter Field:=ColumnHeadingInt, Criteria1:=ArrayOfUniqueValues(ArrayItem)

为：

ActiveSheet.ListObjects("Query2").Range.AutoFilter Field:=ColumnHeadingInt, Criteria1:=ArrayOfUniqueValues(ArrayItem)

一个更强大的修复程序将定义一个正确的工作表变量并使用它

Dim serviceWs As Worksheet
Set serviceWs = Sheets("Service_Level_Detailed")

...
MainWkbk.Activate
serviceWs.Select
ColumnHeadingInt = WorksheetFunction.Match(Range("ExportCriteria").Value, Range("Query2[#Headers]"), 0)
serviceWs.ListObjects("Query2").Range.AutoFilter Field:=ColumnHeadingInt, Criteria1:=ArrayOfUniqueValues(ArrayItem)
serviceWs.Range("Query2[#All]").SpecialCells(xlCellTypeVisible).Copy

但最佳做法是避免任何选择/选择模式并使用完全限定范围对象：

    With MainWkbk.Sheets("Service_Level_Detailed") ' reference wanted sheet in wanted workbook
        ColumnHeadingInt = WorksheetFunction.Match(.Range("ExportCriteria").Value, .Range("Query2[#Headers]"), 0) ' use 'dot' to access referenced object (sheet, in this case) members (ranges, in this case)
        .ListObjects("Query2").Range.AutoFilter Field:=ColumnHeadingInt, Criteria1:=ArrayOfUniqueValues(ArrayItem)
        .Range("Query2[#All]").SpecialCells(xlCellTypeVisible).Copy
    End With

MS Excel VBA将多个工作表拆分为多个文件

1 个答案: