VBA 我可以创建一个由一组工作表组成的可迭代 object 吗？

Question

我试图自动化数据管理，我希望能够 select excel 工作簿上可变数量的工作表，从已知的工作表编号开始，然后循环进入每个工作表到 Z99938282F04071859941E18F1 中的另一个工作表工作簿，以便我可以整合所有数据表并从中创建 pivot 表。 例如，表格看起来像这样：PivotTable,ConsolidatedData,Sheet1,Sheet2,Sheet3,....SheetN

所以我想将每张表中的数据放入合并数据表中。 我想做的是创建一个由选定工作表组成的可迭代动态 object ，这样我就可以遍历每张工作表并复制其数据。

这可以在 VBA 中完成吗？

这是我尝试过的：

'Selecting worksheets'
    Dim x As Integer
    ThisWorkbook.Worksheets(7).Select
        For x = 8 To ThisWorkbook.Worksheets.Count
            Worksheets(x).Select (False)
        Next x

Dim MyArray As Variant
MyArray = Array(ActiveWindow.SelectedSheets)
        
'Loopin through selection of worksheets'
    Dim ws As Worksheet
        For Each ws In MyArray
            ws.Activate
            'Copy/paste of data'
                Range("U9").Select
                Range(Selection, Selection.End(xlToLeft)).Select
                Range(Selection, Selection.End(xlDown)).Select
                Selection.Copy
                Worksheets("ConsolidatedData").Activate
                Range("B1").Select
                Selection.End(xlDown).Select
                ActiveCell.Offset(1).Select
                ActiveSheet.Paste
                Application.CutCopyMode = False
        Next ws

我已经尝试在不使用“MyArray”object 和使用 ActiveWindow.SelectedSheets 的情况下执行此操作，但这不允许我从 ConsolidatedData 到具有数据的表格来回 go。 我想做的事情是可能的还是我应该做不同的事情？

我的主要疑问是这是否可能以某种方式实现：

Dim MyArray As Variant
MyArray = Array(ActiveWindow.SelectedSheets)

Answer 1

这是我使用一组工作表的清理版本。 我还删除了所有 Range.Select，因为它们通常会导致更多错误。

Sub test()
    'Selecting worksheets'
    Dim MyArray() As Variant, wsx As Worksheet
    
    ReDim MyArray(7 To ThisWorkbook.Worksheets.Count)

    For x = 7 To ThisWorkbook.Worksheets.Count
        Set MyArray(x) = ThisWorkbook.Worksheets(x)
    Next x
            
    'Loopin through selection of worksheets'
    For x = LBound(MyArray) To UBound(MyArray)
        'Copy/paste of data'
        Set wsx = ThisWorkbook.Worksheets(x)
        wsx.Range(wsx.Range("U9"), wsx.Range("U9").End(xlToLeft).End(xlDown)).Copy _
            Destination:=Worksheets("ConsolidatedData").Range("B1").End(xlDown).Offset(1)
    Next x
End Sub

我这样做是出于演示目的，但我同意蒂姆·威廉姆斯的评论。 您真的不需要两个循环，因为该数组会立即且完全使用。 您也可以直接引用工作表，而不是保存引用，然后遍历引用数组。 我将只用一个循环重写它，如下所示：

Sub test()
    Dim wsx As Worksheet
    'Loopin through selection of worksheets'
    For x = 7 To ThisWorkbook.Worksheets.Count
        'Copy/paste of data'
        Set wsx = ThisWorkbook.Worksheets(x)
        wsx.Range(wsx.Range("U9"), wsx.Range("U9").End(xlToLeft).End(xlDown)).Copy _
            Destination:=Worksheets("ConsolidatedData").Range("B1").End(xlDown).Offset(1)
    Next x
End Sub

Answer 2

当您开始自动化大规模数据移动时，您在 VBA 中的方法应该不同于在 Excel 中简单记录步骤。 首先，您不必为了读取或写入工作表而对工作表进行 Select。 事实上，所有相关的视频刷新都会显着减慢您的宏。 按数字引用工作表也可能不是一个好主意，它们经常变化。 但我会在这里用它 go 。

要遍历工作表，您可以通过几种方式编写代码，但您需要一个看起来像这样的外部循环：

     Dim OutWorksheet as Worksheet, InWorksheet as Worksheet
     Dim I as integer
     Set OutWorksheet=Worksheets(7)
     For I = 8 to Worksheets.Count
          InWorksheet=Worksheets(I)
               .... Code to copy data from InWorksheet to OutWorksheet
     Next I

您在循环内编写的任何代码都可以直接引用 InWorksheet 而无需选择它。 例如，每张工作表中最后一行数据的编号为 InWorksheet.UsedRange.Rows.Count。

这应该足以让你开始。

Answer 3

这很难解决，试试这个代码我只是改变了你的方式，工作表名而不是工作表作为对象

根据需要替换范围

祝你好运

Sub IterateSheets()
    Dim nRowsData As Double
    Dim SheetMain As String
  
    SheetMain = "Sheet 1" '<--replace (Sheet 1) with your main sheet to consolidate data
    Dim MyArray As Variant
    MyArray = GetSelectedSheetNames
    Sheets(SheetMain).Select
'Loopin through selection of worksheets'

        For Each s In MyArray
                Sheets(s).Select
                'Copy/paste of data'
                Range("U9").Select
                Range(Selection, Selection.End(xlToLeft)).Select
                Range(Selection, Selection.End(xlDown)).Select
                Selection.Copy
                Sheets(SheetMain).Select
                nRowsData = ThisWorkbook.Application.WorksheetFunction.CountA(Range("B:B"))
                Range("B" & nRowsData + 1).Select
                ActiveSheet.Paste
                Application.CutCopyMode = False
        Next s


End Sub

Private Function GetSelectedSheetNames() As Variant
    Dim stringResutl As String
    For   Each ws In ActiveWindow.SelectedSheets
            stringResutl = stringResutl & ws.Name & ";"
    Next ws
    stringResutl = Left(stringResutl, Len(stringResutl) - 1)
    GetSelectedSheetNames = Split(stringResutl, ";")
End Function