函数检查工作表是否存在
函数检查工作表是否存在
提问于 2022-11-15 14:34:16
我有一个函数来检查工作簿中是否已经存在一个名为wsName的工作表。我面临的问题是如何让这个函数与On Error Resume Next的重组和删除一起运行。我期望的是这个宏运行并生成工作簿中不存在的工作表的副本，如果工作表已经存在，则打印出表示ErrorMsg "Unknown Error"的副本。然而，我看到的是，即使工作表不存在，宏也会打印出ErrorMsg并复制它。我正在尝试SheetExists的这种方法，以确定是否有一种方法可以让函数在不使用On Error Resume Next的情况下运行，因为我不希望宏忽略生成的错误，而是希望它打印出"Unknown Error"。
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 SubFunction 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回答 4
Stack Overflow用户
发布于 2022-11-15 14:50:39
您的函数代码始终在最后一行到达，按其方式.
如果工作表对象存在，则必须放置代码行以退出函数：
Function SheetExists_(SheetName As String, wb As Workbook) As Boolean
On Error GoTo Message
SheetExists_ = Not wb.Sheets(SheetName) Is Nothing
If Not wb.Sheets(SheetName) Is Nothing Then Exit Function
Message:
MsgBox "Unknown Error"
End Function编辑的
Function SheetExists_(SheetName As String, wb As Workbook) As Boolean
On Error GoTo Message
SheetExists_ = Not wb.Sheets(SheetName) Is Nothing: Exit Function
Message:
'reaching this part will (only) make it returning `False`...
End Function请注意上面的函数是SheetExists_。它具有名称结束的下划线字符。我还有一个名字叫.
Stack Overflow用户
发布于 2022-11-15 14:52:34
您的"SheetExists“函数将始终将"ErrorMsg”设置为“未知错误”。在SheetExists = Not wb.Sheets(SheetName) Is Nothing后面添加“退出函数”
Stack Overflow用户
发布于 2022-11-15 16:41:40
按照现在的方式，当工作表不存在时，将ErrorMsg设置为“未知错误”。这就是为什么每个工作表都会出现错误，因为每个工作表在测试设置中都是不同的。您的函数仍然会给出一个False (不存在)，但也会给出错误。
编辑：
如果希望ErrorMsg在存在“未知错误”时具有“未知错误”，则需要在未触发On Error Goto消息时实现该错误，如下所示：
Function SheetExists(SheetName As String, wb As Workbook)
On Error GoTo Message
SheetExists = Not wb.Sheets(SheetName) Is Nothing
ErrorMsg = "Unknown Error" 'sheet exists
Exit Function
Message: 'sheet doesn't exist, SheetExists remains false and no errormsg required
End Function页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/74447365
复制相关文章
相似问题
腾讯云开发者
