Question

我们有一份SSRS报告，每个部门都有一个单独的工作表。我们运行一个宏来重命名所有工作表的分区名称，然后将特定的工作表复制到一个新的工作簿，通过电子邮件发送给各个部门。代码的问题在于，如果其中一个分区没有月份的工作表，则宏错误输出错误为＆＃34;不在指定范围内＃34;。有没有办法告诉它如果这次不存在则忽略丢失的工作表？这是代码：

Sheets(Array("AB", "CD", "EF", "GH", "IJ", "KL")).Copy
Sheets("AB").Select
ActiveWorkbook.SaveAs Filename:= _
    Path & "Holder Agings " & Today & ".xlsx", FileFormat:=xlOpenXMLWorkbook, _
    Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
    CreateBackup:=False

谢谢！

Answer 1

我同意Rusan Kax，如果没有完整的代码块，很难准确生成您需要的代码。下面的代码显示了两种技术。您应该能够根据您的要求调整其中一个。

Option Explicit
Sub Test1()

  ' Demonstrate CheckWshts(Array) which removes names from the array
  ' if they do not match the name of a worksheet within the active
  ' workbook

  Dim InxWsht As Long
  Dim WshtTgt() As Variant

  WshtTgt = Array("AB", "CD", "EF", "GH", "IJ", "KL")
  Call CheckWshts(WshtTgt)

  For InxWsht = LBound(WshtTgt) To UBound(WshtTgt)
    Debug.Print WshtTgt(InxWsht)
  Next

End Sub
Sub Test2()

  ' Demonstrates WorksheetExists(Name) which returns True
  ' if worksheet Name is present within the active workbook.

  Dim InxWsht As Long
  Dim WshtTgt() As Variant

  WshtTgt = Array("AB", "CD", "EF", "GH", "IJ", "KL")

  For InxWsht = LBound(WshtTgt) To UBound(WshtTgt)
    If WorksheetExists(CStr(WshtTgt(InxWsht))) Then
      Debug.Print WshtTgt(InxWsht) & " exists"
    Else
      Debug.Print WshtTgt(InxWsht) & " does not exist"
    End If
  Next

End Sub
Sub CheckWshts(WshtTgt() As Variant)

  ' * WshtTgt is an array of worksheet names
  ' * If any name is not present in the active workbook,
  '   remove it from the array

  Dim Found As Boolean
  Dim InxWshtActCrnt As Long
  Dim InxWshtTgtCrnt As Long
  Dim InxWshtTgtMax As Long

  InxWshtTgtCrnt = LBound(WshtTgt)
  InxWshtTgtMax = UBound(WshtTgt)

  Do While InxWshtTgtCrnt <= InxWshtTgtMax
    Found = False
    For InxWshtActCrnt = 1 To Worksheets.Count
      If Worksheets(InxWshtActCrnt).Name = WshtTgt(InxWshtTgtCrnt) Then
        Found = True
        Exit For
      End If
    Next
    If Found Then
      ' Worksheet WshtTgt(InxWshtTgtCrnt) exists
      InxWshtTgtCrnt = InxWshtTgtCrnt + 1
    Else
      ' Worksheet WshtTgt(InxWshtTgtCrnt) does not exist
      WshtTgt(InxWshtTgtCrnt) = WshtTgt(InxWshtTgtMax)
      InxWshtTgtMax = InxWshtTgtMax - 1
    End If
  Loop

  ' Warning this code does not handle the situation
  ' of none of the worksheets existing

  ReDim Preserve WshtTgt(LBound(WshtTgt) To InxWshtTgtMax)

End Sub
Function WorksheetExists(WshtName As String)

  ' Returns True is WshtName is the name of a
  ' worksheet within the active workbook.

  Dim InxWshtCrnt As Long

    For InxWshtCrnt = 1 To Worksheets.Count
      If Worksheets(InxWshtCrnt).Name = WshtName Then
        WorksheetExists = True
        Exit Function
      End If
    Next

  WorksheetExists = False

End Function

Answer 2

由于Worksheets集合不提供任何方法，可以让我们检查特定工作表名称是否代表有效工作表，我们必须遍历所有工作表名称并尝试获取项目的集合。这里有On Error Resume Next的示例，如果特定名称不代表现有工作表，则会忽略错误。这样，allNames数组将被过滤，并且无效名称不会添加到仅包含有效名称的新数组names。

Public Sub test()
    Dim allNames As Variant
    Dim names As Variant
    Dim name As Variant
    Dim someSheet As Worksheet

    allNames = Array("AB", "CD", "EF", "GH", "IJ", "KL")

    On Error Resume Next

    For Each name In allNames
        Err.Number = 0
        Set someSheet = Worksheets(name)
        If Err.Number <> 0 Then _
            GoTo continue

        If IsArray(names) Then
            ReDim Preserve names(UBound(names) + 1)
        Else
            ReDim names(0 To 0)
        End If

        names(UBound(names)) = name
continue:
    Next name

    On Error GoTo 0

    If Not IsArray(names) Then _
        Exit Sub

    Sheets(names).Copy
    ' your code ...
End Sub

宏，使用数组将工作表复制到不同的工作簿

2 个答案: