简体   繁体   English

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

[英]VBA Can I create an Iterable object made of a selection of WorkSheets?

Im trying to automate a data management, I want to be able to select a variable number of sheets on an excel workbook, starting from a known sheet number, then loop into each sheet to select the data an then copy it into another sheet in the workbook so I can have a consolidate of all the data sheets and create a pivot table from it.我试图自动化数据管理,我希望能够 select excel 工作簿上可变数量的工作表,从已知的工作表编号开始,然后循环进入每个工作表到 Z99938282F04071859941E18F1 中的另一个工作表工作簿,以便我可以整合所有数据表并从中创建 pivot 表。 For example the Sheets would look like this: PivotTable,ConsolidatedData,Sheet1,Sheet2,Sheet3,....SheetN例如,表格看起来像这样:PivotTable,ConsolidatedData,Sheet1,Sheet2,Sheet3,....SheetN

So I want to take the data from each Sheet into the Consolidated data sheet.所以我想将每张表中的数据放入合并数据表中。 What Im trying to do is to create an iterable dynamic object made of selected sheets so then I can iterate over every sheet and copy its data.我想做的是创建一个由选定工作表组成的可迭代动态 object ,这样我就可以遍历每张工作表并复制其数据。

Can this be done in VBA?这可以在 VBA 中完成吗?

This is what i have tried:这是我尝试过的:

'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

I´ve tried doing it without using the "MyArray" object and using ActiveWindow.SelectedSheets but this does not allows me to go back and forth from the ConsolidatedData to the Sheets that have the data.我已经尝试在不使用“MyArray”object 和使用 ActiveWindow.SelectedSheets 的情况下执行此操作,但这不允许我从 ConsolidatedData 到具有数据的表格来回 go。 What I want to do is possible or should I do it differently?我想做的事情是可能的还是我应该做不同的事情?

My main doubt is if this is even possible in some way:我的主要疑问是这是否可能以某种方式实现:

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

Here's my cleaned up version using an array of worksheets.这是我使用一组工作表的清理版本。 I also removed all of the Range.Select because they often cause more errors.我还删除了所有 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

I made this for demonstrative purposes but I agree with Tim Williams' comment.我这样做是出于演示目的,但我同意蒂姆·威廉姆斯的评论。 You really don't need two loops since the array is used immediately and fully.您真的不需要两个循环,因为该数组会立即且完全使用。 You may as well just directly reference the sheets rather than save the references and then loop through the array of references.您也可以直接引用工作表,而不是保存引用,然后遍历引用数组。 I would rewrite it with only one loop as follows:我将只用一个循环重写它,如下所示:

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

When you start automating large scale data moves your approach in VBA should be different than simply recording the steps to do it in Excel.当您开始自动化大规模数据移动时,您在 VBA 中的方法应该不同于在 Excel 中简单记录步骤。 Firstly, you do not have to Select a worksheet in order to read or write to it.首先,您不必为了读取或写入工作表而对工作表进行 Select。 Indeed, all of that associated video refreshing will significantly slow your macro.事实上,所有相关的视频刷新都会显着减慢您的宏。 It's also probably not a good idea to refer to worksheets by number, they change often.按数字引用工作表也可能不是一个好主意,它们经常变化。 But I'll go with it for here.但我会在这里用它 go 。

To iterate through the worksheets you can write code a few ways but you'll want an outer loop that looks something like:要遍历工作表,您可以通过几种方式编写代码,但您需要一个看起来像这样的外部循环:

     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

Any code you write inside the loop can reference InWorksheet directly without Selecting it.您在循环内编写的任何代码都可以直接引用 InWorksheet 而无需选择它。 For example, the number of the last row with data in each sheet is InWorksheet.UsedRange.Rows.Count.例如,每张工作表中最后一行数据的编号为 InWorksheet.UsedRange.Rows.Count。

That should be enough to get you started.这应该足以让你开始。

this was hard to solve, try this code i just changed your way, sheetnames instead sheets as objects这很难解决,试试这个代码我只是改变了你的方式,工作表名而不是工作表作为对象

replace ranges as you need根据需要替换范围

Good Luck祝你好运

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

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM