Excel 2010 VBA:如何将工作表数组存储为变量?

时间:2013-06-18 12:44:56

标签: excel vba excel-vba excel-2010

我正在尝试使用我的代码中可以调用的几个工作表数组。

ThisWorkbook.Sheets(Array("Sheet1", "Sheet3"))
ThisWorkbook.Sheets(Array("Sheet2", "Sheet5"))

我想知道是否有设置类似于以下内容的变量:

Dim ArrayOne As String
Dim ArrayTwo As String

ArrayOne = ThisWorkbook.Sheets(Array("Sheet1", "Sheet3"))
ArrayTwo = ThisWorkbook.Sheets(Array("Sheet2", "Sheet5"))

ArrayOne 'Call this Array then save

Filename:="C:\Data\testfile.xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _,
CreateBackup:=False 

ArrayTwo 'Call this array then save

Filename:="C:\Data\testfile.xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _,
CreateBackup:=False 

如果你能帮助我,请告诉我!!

5 个答案:

答案 0 :(得分:4)

以下是VBA中数组如何工作的示例:

Sub Example()
    Dim ArrayOne() As String
    Dim ArrayTwo() As String
    Dim ArrayThree As Variant
    Dim i As Long

    ReDim ArrayOne(1 To Sheets.Count)
    ReDim ArrayTwo(1 To 2)

    For i = 1 To Sheets.Count
        ArrayOne(i) = Sheets(i).Name
    Next

    ArrayTwo(1) = "Sheet1"
    ArrayTwo(2) = "Sheet2"

    ArrayThree = Array("Sheet1", "Sheet3")
End Sub

根据我的理解,你不想使用数组。您可以在工作簿中引用工作表,如下所示:

Sheets("SheetName") 'SheetName is the name of your sheet
Sheets(1)           '1 = sheet index

将工作表复制到要保存的新工作簿的一种方法是:

Sub Example()
    Dim wkbk As Workbook

    ThisWorkbook.Sheets("Sheet1").Copy
    Set wkbk = ActiveWorkbook
    ThisWorkbook.Sheets("Sheet3").Copy After:=wkbk.Sheets(wkbk.Sheets.Count)

    wkbk.SaveAs FileName:="C:\New Excel Book.xlsx", _
                FileFormat:=xlOpenXMLWorkbook
    wkbk.Close
End Sub

答案 1 :(得分:3)

尝试使用记录宏功能。它允许您选择多个工作表,然后将它们复制到新书中。接下来保存那本书,你就在那里。现在修补代码,让它按照你想要的方式工作。

它将归结为:

ThisWorkbook.Sheets(Array("Sheet1", "Sheet3")).Copy
ActiveWorkbook.SaveAs ...

如果你想预定义数组,那也很容易做到;那些只需要包含工作表的名称。可以使用Variable变量创建数组:

Dim ArrayOne as Variant
ArrayOne = Array("Sheet1", "Sheet3")

并在.Sheets().Copy

中使用它
ThisWorkbook.Sheets(ArrayOne).Copy

答案 2 :(得分:2)

我在尝试创建动态数组时遇到了类似的问题(不知道有多少张表供我处理)。我只是用这个:

Sub copyArrayOfSheets()

Dim loopArray() As Variant

ReDim Preserve loopArray(1 To 1)
loopArray(1) = "Sheet1" ' a Sheet I know I need to export

j = 1
For Each loopSheet In ThisWorkbook.Sheets
    If loopSheet.Name <> "Sheet1" Then
        theName = loopSheet.Name
        j = j + 1
        ReDim Preserve loopArray(1 To j)
        loopArray(j) = theName ' Assign the name of the sheets to j-th position of loopArray() 
    End If
Next loopSheet

Sheets(loopArray()).Copy

Set newBook = ActiveWorkbook    
newBook.Activate

End Sub

希望这有助于任何方式...

答案 3 :(得分:0)

按照Arthur的解决方案(最后评论),我遇到了类似的问题(因此达到了这个帖子):我试图创建一个动态数组,它可以在数组中的工作簿中保存一系列工作表,然后执行特定的操作用那个数组。

不同之处在于,用户在excel中的范围(列)中定义工作表的名称(它们代表另一个宏的方案),但是此范围可能会扩展或缩短。

我使用2个数组,其中我在第一个数组中运行循环,每次将扩展名保存到另一个数组(出于透明度原因)。代码:

Sub testArray()
    Dim a, b As Integer
    scenarios_number = Sheets(sheet1).[c1] - 1 ' (this is where i put the # of scenarios / sheets (-1 is used as i want the array to start from 0))
    a = 0
    Dim Scenarios_array, dimension_array() As Variant
    ReDim Scenarios_array(0 To scenarios_number) '(resize array to match the #'s of scenarios)
    ReDim dimension_array(0 To a)
    For a = 0 To scenarios_number
    Scenarios_array(a) = Range("c8").Offset(a, 0).Value '(this is where my scenarios' names start within sheet1 -- using offset for the loop -- this is why i use -1 above as i want a to start @ 0)
    ReDim Preserve dimension_array(0 To a) ' (expand dimension of 2nd array)
    dimension_array(a) = Scenarios_array(a) ' (save the value in the second array, expaning its dimensions)
    Next
    MsgBox "Get Ready"
    Sheets(dimension_array()).Select
    ActiveWindow.SelectedSheets.Delete
End Sub

希望有所帮助:)

答案 4 :(得分:0)

我也试图这样做,但我发现了另一种方式

我想要完成的是我有一张多张工作簿,并给了他们一个名字。我想选择几张纸并排除一些需要导出到不同excel文件的纸张。

这是(在经过大量搜索和尝试之后)我的代码

达斯汀

Dim ii As Integer 'Counter of worksheets
Dim namefile as string 'Variable for name of the new file
namefile = "NameOfNewFile.xlsx" 'Name of new file

For ii = 1 To ThisWorkbook.Sheets.Count 'Counts from 1 to last sheetnumber
    If Sheets(ii).Name <> "Namesheet1" Then If Sheets(ii).Name <> "Namesheet2" Then Sheets(ii).Select Replace:=False 
    'NameSheet1 and NameSheet2 are being exluded from the new file
Next ii

ActiveWindow.SelectedSheets.Copy 'Copies the selected files

Set NewWb = ActiveWorkbook
NewWb.SaveAs Filename:= _
"C:\Users\" & Environ("UserName") & "\Desktop\" & namefile, FileFormat:=xlOpenXMLWorkbook 
'Saves as xlsx file to desktop
NewWb.Close 'Closes the new file
Set NewWb = Nothing 'Clear NewWb to reduce memory usage