Question

我正在尝试添加工作表，并根据其他工作簿中单元格的内容对其进行命名（如果该工作表尚不存在）。如果其他工作簿已经打开，代码似乎工作正常，但如果我必须通过我的代码打开工作簿，则ISREF不起作用。如果使用代码打开工作簿，它将创建一个新工作表，然后尝试命名它并导致错误，因为已经有一个具有该名称的工作表。

If AlreadyOpen = False Then Workbooks.Open ("Class Attendance.xlsm")
For i = 2 To Workbooks("Class Attendance.xlsm").Worksheets("Attendance").Range("A" & Rows.Count).End(xlUp).Row
    sName = Workbooks("Class Attendance.xlsm").Worksheets("Attendance").Cells(i, 4) & ", " & Workbooks("Class Attendance.xlsm").Worksheets("Attendance").Cells(i, 5)

    'If member sheet already exists add dates
    If Evaluate("ISREF('" & sName & "'!A1)") = True Then

    'If member sheet doesn't exist, create one
    ElseIf sName <> ", " Then
        Set WS = thisWB.Sheets.Add(After:=Sheets(Sheets.Count))
        WS.Name = sName
        Cover.Activate
    End If
Next i

Answer 1

在这些情况下仔细使用On Error语句是完全可以接受的：

Public Sub AddSheet()
    Dim wb As Workbook
    Dim ws as Worksheet

    On Error Resume Next
        Set wb = Workbooks("Book1") 'if workbook is open
    On Error GoTo 0

    If wb Is Nothing Then
        Set wb = Workbooks.Open("../../Book1.xlsx") 'if workbook is closed
    End If

    On Error Resume Next
        Set ws = wb.Worksheets("SomeName") 'if worksheet exists
    On Error GoTo 0

    If ws Is Nothing Then 'if worksheet doesn't exist
        Set ws = wb.Worksheets.Add(after:=wb.Worksheets.Count)
        ws.Name = "SomeName"
    End If
End Sub

Answer 2

这是另一个利用辅助函数的答案：

Sub Test()
    Dim wbSrc As Workbook: Set wbSrc = GetWorkBook(".\Class Attendance.xlsm", True) 'Full Path Required
    Dim sName As String, ws As Worksheet

    With wbSrc.Worksheets("Attendance")
        For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
            sName = .Cells(i, 4) & ", " & .Cells(i, 5)
            If Not WorkSheetExists(ThisWorkbook, sName) Then
                Set ws = ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count))
                ws.Name = sName
            End If
        Next i
    End With
End Sub

Function GetWorkBook(ByVal sFullName As String, Optional ReadOnly As Boolean) As Workbook
    Dim sFile As String: sFile = Dir(sFullName)
    On Error Resume Next
    Set GetWorkBook = Workbooks(sFile)
    If GetWorkBook Is Nothing Then Set GetWorkBook = Workbooks.Open(sFullName, ReadOnly:=ReadOnly)
End Function

Function WorkSheetExists(ByVal wb As Workbook, ByVal strName As String) As Boolean
   On Error Resume Next
   WorkSheetExists = Not wb.Worksheets(strName) Is Nothing
End Function

ISREF仅在外部工作簿已打开时才有效

2 个答案: