用于存储 sheet 名称的动态数组

Question

Hye 我想做的是：

从其他工作簿合并 sheet
使用merge上的数据sheet进行计算得到结果
结果会贴在他们的sheet
计算完成后制作汇总选项卡，合并此选项卡中的所有数据
将摘要选项卡和其他合并选项卡保存到新工作簿

我的问题是：我想用一个动态数组替换这个 twb.Sheets(Array("Summary", "M 100P 1", "M 100P 2", "M 100P 5", "M 100P 6", "M 100P 12", "M 100P 13", "M 100P 15", "M 100P 16")).Copy 因为合并的名称 sheet 遵循它们的原始文件并且它可能会有所不同我不能使用 "Like" 条件所以我尝试使用下面的代码但是它 return myArray 是空的

Option Base 1
Sub SheetsArr()
    Dim myArray() As String
    Dim myCount As Integer, NumSheets As Integer

    NumSheets = ThisWorkbook.Worksheets.Count - 4
    ReDim myArray(1 To NumSheets)

    For myCount = 4 To NumSheets
        myArray(myCount) = ActiveWorkbook.Sheets(myCount).Name
    Next myCount
End Sub

遇到错误

Type Mismatch error

并突出显示主模块上的这行代码 If UBound(myArray) > 0 Then Worksheets(myArray).Copy

这是我的主要模块代码：

Private Sub OpenWorkBook_Click()
    'for merge sheet from other workbooks
    Dim wbk, twb As Workbook
    Dim sPath, sFile, sName, mySheet As String
    Dim cpt, wsCountMerge, wsCount, WsIndex As Integer

    sPath = "C:\Users\mazman\Desktop\Hilmi\data Summary\" 'Your folder path
    sFile = Dir(sPath & "*.xls*")

    Set twb = ThisWorkbook
    Application.ScreenUpdating = 0

    Countmergesheet = 0
    Do While sFile <> "" 'merge raw data sheet process start here
        Set wbk = Workbooks.Open(sPath & sFile)

        With wbk
            sName = Split(Split(.Name, "_")(6), ".")(0) 'initialize sheet name based on the file name
            .Sheets(3).Copy after:=twb.Sheets(twb.Sheets.Count) 'copy each sheets(3) from the data summary and paste after visible sheet on this workbook
            .Close 0
        End With

        With twb
        .ActiveSheet.Name = sName 'rename sheet
        .ActiveSheet.Range("A1:R1").RowHeight = 45
        .ActiveSheet.Range("A1:R1").WrapText = True
        .ActiveSheet.Range("A1:R1").Interior.ColorIndex = 15
        End With
        sFile = Dir()

        If twb.ActiveSheet.Name = sName Then
            Countmergesheet = Countmergesheet + 1 'count how many sheet is merge
        End If
    Loop

    wsCount = twb.Sheets.Count
    wsCountMerge = wsCount - Countmergesheet 'to get the 1st merge sheet index
    WsIndex = wsCount - 1 'to get the last sheet index

    '################# This section copy data from origin sheet #################
    '###### to formula sheet then paste result to its origin sheet ##############
    For i = wsCountMerge To WsIndex
    With twb
    .Sheets(i).Range("A2:R3063").Copy
    .Worksheets("STEP 1").Range("A3").PasteSpecial xlPasteValues

    .Sheets(i).Cells.Clear
    .Sheets(3).Range("A9:O27").Copy
    .Sheets(i).Range("A1").PasteSpecial xlPasteAllUsingSourceTheme
    .Sheets(i).Range("A1").PasteSpecial xlPasteValues
    .Sheets(i).Range("A1:O19").ColumnWidth = 10.8

    '################# This section copy data to summary sheet ################
    .Sheets(i).Range("A2:O18").Copy
    .Worksheets("Summary").Select
    ActiveSheet.Range("B" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveSheet.Paste

    For j = 1 To 17
    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.Value = .Sheets(i).Name
    ActiveCell.BorderAround , xlThin
    Next j

    .Worksheets("STEP 1").Range("A3:R6034").Clear
    .Worksheets("STEP 1").Activate: .Sheets("STEP 1").Cells(1).Select
    .Sheets(i).Activate: .Sheets(i).Cells(1).Select
    .Sheets("Summary").Activate: .Sheets("Summary").Cells(1).Select
    '######                   End of section                   ################

    End With
    Next i

    Call InsertFormulas
    Call SheetsArr

    If UBound(myArray) > 0 Then Sheets(myArray).Copy
    ActiveWorkbook.SaveAs Filename:=sPath & "Summary Report" & ".xlsx"
End Sub

Answer 1

您的 ReDim 使 myArray 从 1 开始。但是 for 循环计数器 myCount 从 4.

开始

我更正了循环计数器，myCount，从 1 开始，如下所示。

Sub SheetsArr()
    Dim myArray() As Variant
    Dim myCount As Long, NumSheets As Long

    NumSheets = ThisWorkbook.Worksheets.Count - 4
    ReDim myArray(1 To NumSheets)

    For myCount = 1 To NumSheets
        myArray(myCount) = ActiveWorkbook.Sheets(myCount).Name
    Next myCount
End Sub

新答案

根据您的 main module 代码，我认为您可以

步骤 1.

将您的 SheetArr() sub 重写为如下函数。

Option Base 1
Function SheetsArr() As Variant
    Dim myArray() As Variant  'from String to Variant
    Dim myCount As Long, NumSheets As Long  'from Integer to Long

    NumSheets = ThisWorkbook.Worksheets.Count - 4
    ReDim myArray(1 To NumSheets)

    For myCount = 1 To NumSheets
        myArray(myCount) = ThisWorkbook.Worksheets(myCount).Name 'from ActiveWorkbook.Sheets to ThisWorkbook.Worksheets as the definition of NumSheets
    Next myCount
    SheetsArr = myArray
End Function

第 2 步。

在main module中，需要添加

Dim myArray As Variant

重写

Call SheetsArr

到

myArray = SheetsArr()

用于存储 sheet 名称的动态数组

Dynamic Array to store sheet Name

excel

dynamic-arrays

新答案

步骤 1.

第 2 步。