您知道Excel VBA中直接选择数组中已有多个工作表的任何直接方法吗？

问题描述

我有一段代码可以从工作表中创建可变数量的副本。 每个新副本都设置为数组中的下一个Worksheet类型变量：

Dim wsv() as Worksheet
Dim ddf as Integer,i as Integer

'After some processing,ddf will define the number of copies required,'therefore the size of the array.

'ws is the original worksheet from which the copies will be made

If ddf > 0 then

    ReDim wsv(0 to ddf) as Worksheet
    
    For i = 0 to ddf
        ws.copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        Set wsv(i) = ThisWorkbook.ActiveSheet
    Next i

End if

我需要最后选择所有这些新工作表，以便将它们导出为单个PDF。

在已知要选择的工作表的数量/名称的情况下，我使用过ThisWorkbook.Sheets(Array("Sheet1","Sheet2","Sheet3")).Select，我希望ThisWorkbook.Sheets(wsv).Select或ThisWorkbook.Sheets(Array(wsv)).Select在此特定工作表中可以使用，但是他们没有。

您知道我该怎么做，利用所有必需的工作表已在数组中进行选择吗？

更新：

我需要使用字符串数组来代替，因为这是ThisWorkbook.Sheets(Array("Sheet1","Sheet3")).Select的期望。 感谢@BigBen和@ VBasic2008的帮助！

解决方法

工作表数组

• 函数createWorksheetsArray是一种混合形式。它像Sub一样创建新的工作表，并像Function一样返回新创建的工作表的工作表名称数组。

• 过程testCreateWorksheetsArray将三个工作表添加到包含此代码（ThisWorkbook）的工作簿中，在数组中返回这三个名称，并将其内容打印到Immediate window CTRL + G ，然后“一次性”删除所有三个工作表。

• 您宁愿做这样的事情，也不想删除：

  wb.Worksheets(wsv).Select
  ActiveSheet.ExportAsFixedFormat...
  

新版本

Option Explicit

Sub addWorksheetCopies(Sheet As Worksheet,_
                       Optional ByVal NumberOfCopies As Long = 1)
    
    If Sheet Is Nothing Then
        GoTo ProcExit
    End If
    
    If NumberOfCopies < 1 Then
        GoTo ProcExit
    End If
    
    With Sheet
        Dim n As Long
        For n = 1 To NumberOfCopies
            .Copy After:=.Parent.Sheets(.Parent.Sheets.Count)
        Next n
    End With

ProcExit:

End Sub

Function getLastWorkSheetNames(Book As Workbook,_
                               Optional ByVal NumberOfWorksheets As Long) _
         As Variant
    
    Dim wsCounter As Long
    wsCounter = NumberOfWorksheets
    Dim Data As Variant
    ReDim Data(1 To wsCounter)
    Dim shCounter As Long
    shCounter = Book.Sheets.Count
    
    Dim sh As Object
    Do
        Set sh = Book.Sheets(shCounter)
        If sh.Type = xlWorksheet Then
            Data(wsCounter) = sh.Name
            wsCounter = wsCounter - 1
            shCounter = shCounter - 1
        End If
    Loop Until wsCounter = 0
    getLastWorkSheetNames = Data

ProcExit:

End Function

Sub testBoth()
    
    Const NumberOfCopies As Long = 3
    
    ' Define workbook.
    Dim wb As Workbook
    Set wb = ThisWorkbook
    
    ' Define Source Worksheet ('ws').
    Dim ws As Worksheet
    Set ws = wb.Worksheets("Sheet1")
    
    ' Create copies of Source Worksheet.
    addWorksheetCopies ws,NumberOfCopies
    
    ' Write the names of the copies to Worksheets Array ('wsv').
    Dim wsv As Variant
    wsv = getLastWorkSheetNames(wb,NumberOfCopies)
    If IsEmpty(wsv) Then
        GoTo ProcExit
    End If
    
    ' Status:
    ' You have created your copies of worksheet ws,' and the array wsv contains the names of the copied worksheets.
    ' Continue...
    
    ' e.g.
    Dim n As Long
    For n = LBound(wsv) To UBound(wsv)
        Debug.Print wsv(n)
    Next n
    
    Application.DisplayAlerts = False
    wb.Worksheets(wsv).Delete
    Application.DisplayAlerts = True
    
ProcExit:
    
End Sub

代码气味版本（不推荐）

Function createWorksheetsArray(SourceWorksheet As Worksheet,_
                               Optional ByVal NumberOfCopies As Long = 1) _
         As Variant
    
    If SourceWorksheet Is Nothing Then
        GoTo ProcExit
    End If
    
    If NumberOfCopies < 1 Then
        GoTo ProcExit
    End If
    
    Dim Data As Variant
    ReDim Data(1 To NumberOfCopies)
    With SourceWorksheet
        Dim n As Long
        For n = 1 To NumberOfCopies
            .Copy After:=.Parent.Sheets(.Parent.Sheets.Count)
            Data(n) = .Parent.ActiveSheet.Name
        Next n
    End With

    createWorksheetsArray = Data

ProcExit:

End Function

Sub testCreateWorksheetsArray()
    
    Dim wb As Workbook
    Set wb = ThisWorkbook
    
    Dim ws As Worksheet
    Set ws = wb.Worksheets("Sheet1")
    
    Dim wsv As Variant
    wsv = createWorksheetsArray(ws,3)
    If IsEmpty(wsv) Then
        GoTo ProcExit
    End If
    
    Dim n As Long
    For n = LBound(wsv) To UBound(wsv)
        Debug.Print wsv(n)
    Next n
    
    Application.DisplayAlerts = False
    wb.Worksheets(wsv).Delete
    Application.DisplayAlerts = True
    
ProcExit:
    
End Sub

,

最新添加到“如何选择多个工作表？”

如Jorge在更新的问题中所述

“我需要使用 字符串数组 代替”

让我继续思考：

1. 一方面使用ThisWorkbook.Worksheets(Array("Sheet1","Sheet2","Sheet3")).Select或 或通过ThisWorkbook.Worksheets(wsNames).Select的预定义数组 实际上必须与包含字符串的数组相对应。

   顺便说一句，而不是选择整个工作表列表， 还可以将选择组一个一个地扩大 ：

    Sub SelectWorksheets()
    Dim wsNames As Variant  ' Split needs a variant array type
    wsNames = Split("Tabelle1,Tabelle2",","): If UBound(wsNames) = -1 Then Exit Sub
    'a) select first sheet thus removing any prior selection
        Dim i As Long: i = LBound(wsNames)
        ThisWorkbook.Worksheets(wsNames(i)).Select
    'b) select next items
        For i = i + 1 To UBound(wsNames)
            With ThisWorkbook.Worksheets(wsNames(i))
                'add to existing selection
                .Select (False) ' note the False argument adding to existing selection

                'do further stuff
                '...
            End With
        Next i
    End Sub

1. 另一方面，豪尔赫（Jorge）首先尝试声明Worksheet类型，为什么不呢？

   因此，我立即使用项目表来演示另一种方法►代码（名称）：

    Sub SelectViaCodeNames()
    Dim wsCodes: wsCodes = Array(Tabelle1,Tabelle2): If UBound(wsCodes) = -1 Then Exit Sub
    'a) select first sheet thus removing any prior selection
        Dim i As Long: i = LBound(wsCodes)
        wsCodes(i).Select
    'b) select next items
        For i = i + 1 To UBound(wsCodes)
            With wsCodes(i)
                'add to existing  selection
                .Select (False)
            
                'do further stuff
                '...
            End With
        Next i
    End Sub

唯一的缺点是，不能将整个Code（Name）列表作为参数传递给类似对象Worksheets。