您知道在 Excel VBA 到 select 数组中已有多个工作表的任何直接方法吗?
Do you know any direct way in Excel VBA to select multiple worksheets already in an array?
我有一段代码可以从工作表创建可变数量的副本。
每个新副本都设置为数组中的下一个工作表类型变量:
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
最后我需要 select 所有这些新工作表,以便将它们导出为单个 PDF。
我在 select 的工作表 quantity/name 已知的情况下使用了 ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
,我希望 ThisWorkbook.Sheets(wsv).Select
或 ThisWorkbook.Sheets(Array(wsv)).Select
会在这个特别的地方工作,但他们不会。
你知道我该怎么做吗,利用数组中已经 select 的所有必需工作表?
更新:
我需要改用字符串数组,因为这是 ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
所期望的。
感谢@BigBen 和@VBasic2008 的帮助!
工作表数组
函数 createWorksheetsArray
是一种混合函数。它像 Sub
那样创建新的工作表,它 returns 新创建的工作表的工作表名称数组,就像 Function
那样。
过程testCreateWorksheetsArray
将三个工作表添加到包含此代码的工作簿(ThisWorkbook
),returns数组中的三个名称,其内容打印到Immediate window
CTRL+G 删除所有三个工作表之前 'in one go'.
与其删除,不如这样:
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
Code Smell版本(不推荐)
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
“如何 select 多个工作 sheets?”的后期补充
正如 Jorge 在更新的问题中提到的那样
"I needed to use an array of strings instead"
让我继续这个思路:
一方面使用ThisWorkbook.Worksheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
或者
或通过 ThisWorkbook.Worksheets(wsNames).Select
预定义的数组
实际上必须对应一个包含[=36=]strings.
的数组
顺便说一句,而不是 select 编辑 整个 sheet 列表 ,
也可以将 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
另一方面,豪尔赫首先尝试声明 Worksheet
类型,为什么不呢?
因此,我立即使用项目的 sheet ►Code(Names):
来演示替代方案
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
唯一的缺点是,据我所知,您不能将整个代码(名称)列表作为参数传递给类似 Worksheets
集合的可比较对象。
我有一段代码可以从工作表创建可变数量的副本。 每个新副本都设置为数组中的下一个工作表类型变量:
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
最后我需要 select 所有这些新工作表,以便将它们导出为单个 PDF。
我在 select 的工作表 quantity/name 已知的情况下使用了 ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
,我希望 ThisWorkbook.Sheets(wsv).Select
或 ThisWorkbook.Sheets(Array(wsv)).Select
会在这个特别的地方工作,但他们不会。
你知道我该怎么做吗,利用数组中已经 select 的所有必需工作表?
更新:
我需要改用字符串数组,因为这是 ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
所期望的。
感谢@BigBen 和@VBasic2008 的帮助!
工作表数组
函数
createWorksheetsArray
是一种混合函数。它像Sub
那样创建新的工作表,它 returns 新创建的工作表的工作表名称数组,就像Function
那样。过程
testCreateWorksheetsArray
将三个工作表添加到包含此代码的工作簿(ThisWorkbook
),returns数组中的三个名称,其内容打印到Immediate window
CTRL+G 删除所有三个工作表之前 'in one go'.与其删除,不如这样:
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
Code Smell版本(不推荐)
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
“如何 select 多个工作 sheets?”的后期补充
正如 Jorge 在更新的问题中提到的那样
"I needed to use an array of strings instead"
让我继续这个思路:
一方面使用
的数组ThisWorkbook.Worksheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
或者 或通过ThisWorkbook.Worksheets(wsNames).Select
预定义的数组 实际上必须对应一个包含[=36=]strings.顺便说一句,而不是 select 编辑 整个 sheet 列表 , 也可以将 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
另一方面,豪尔赫首先尝试声明
Worksheet
类型,为什么不呢?因此,我立即使用项目的 sheet ►Code(Names):
来演示替代方案
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
唯一的缺点是,据我所知,您不能将整个代码(名称)列表作为参数传递给类似 Worksheets
集合的可比较对象。