问函数检查工作表是否存在

EN

Global Parameter As Long, RoutingStep As Long, wsName As String, version As String, ErrorMsg As String, SDtab As Worksheet
Global wb As Workbook, sysrow As Long, sysnum As String, ws As Worksheet

Public Sub Main()
    Dim syswaiver As Long, axsunpart As Long
    Dim startcell As String, cell As Range
    Dim syscol As Long, dict As Object, wbSrc As Workbook

Set wb = Workbooks("SD3_KW.xlsm")
Set ws = wb.Worksheets("Data Sheet") 


syswaiver = 3
axsunpart = 4


Set wbSrc = Workbooks.Open("Q:\Documents\Specification Document.xlsx")
Set dict = CreateObject("scripting.dictionary") 

If Not syswaiver = 0 Then
    startcell = ws.cells(2, syswaiver).Address 
Else
    ErrorMsg = "waiver number column index not found. Value needed to proceed"
    GoTo Skip
End If

For Each cell In ws.Range(startcell, ws.cells(ws.Rows.Count, syswaiver).End(xlUp)).cells 
    sysnum = cell.value
    sysrow = cell.row
    syscol = cell.column
    
    If Not dict.Exists(sysnum) Then 
        dict.Add sysnum, True
    
        If Not SheetExists(sysnum, wb) Then 
            If Not axsunpart = 0 Then
                wsName = cell.EntireRow.Columns(axsunpart).value 
                If SheetExists(wsName, wbSrc) Then 
                    wbSrc.Worksheets(wsName).copy After:=ws 
                    wb.Worksheets(wsName).Name = sysnum 
                Set SDtab = wb.Worksheets(ws.Index + 1)
                Else
                    ErrorMsg = ErrorMsg & IIf(ErrorMsg = "", "", "") & "part number for " & sysnum & " sheet to be copied could not be found"
                    cell.Interior.Color = vbRed
                GoTo Skip
                End If
      Else
                ErrorMsg = "part number column index not found. Value needed to proceed"
            End If 
            
        Else 
            MsgBox "Sheet " & sysnum & " already exists."
        End If
    End If
    
Skip:

Dim begincell As Long, logsht As Worksheet 
Set logsht = wb.Worksheets("Log Sheet") 
    With logsht ' wb.Worksheets("Log Sheet")
        begincell = .cells(Rows.Count, 1).End(xlUp).row
        .cells(begincell + 1, 3).value = sysnum
        .cells(begincell + 1, 3).Font.Bold = True
        .cells(begincell + 1, 2).value = Date
        .cells(begincell + 1, 2).Font.Bold = True

        If Not ErrorMsg = "" Then
            .cells(begincell + 1, 4).value = vbNewLine & "Complete with Erorr - " & vbNewLine & ErrorMsg
            .cells(begincell + 1, 4).Font.Bold = True
            .cells(begincell + 1, 4).Interior.Color = vbRed
        Else
            .cells(begincell + 1, 4).value = "All Sections Completed without Errors"
            .cells(begincell + 1, 4).Font.Bold = True
            .cells(begincell + 1, 4).Interior.Color = vbGreen
        End If
    End With

Next Cell 

End Sub

Function SheetExists(SheetName As String, wb As Workbook)  
On Error GoTo Message
SheetExists = Not wb.Sheets(SheetName) Is Nothing
Exit Function
Message:
    ErrorMsg = "Unknown Error"
End Function