用于存储工作表名称的动态数组 第1步。步骤2。

我想做的是:

  • 合并其他工作簿中的工作表
  • 使用合并表中的数据进行计算并获得结果
  • 结果将粘贴到他们的工作表上
  • 计算完成后,创建“摘要”选项卡,其中将合并此选项卡中的所有数据
  • 将“摘要”标签和其他合并标签保存到新工作簿中

我的问题是: 我想用动态数组替换此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,因为合并表的名称遵循其原始文件,并且可能会有所不同。我无法使用“赞”条件,因此我尝试使用下面的代码,但返回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

错误

  

类型不匹配错误

并在主模块上突出显示此行代码 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
liuyao302 回答:用于存储工作表名称的动态数组 第1步。步骤2。

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

我更正for循环计数器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()子代重写为以下函数。

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()
本文链接:https://www.f2er.com/3126830.html

大家都在问