在工作簿中找到了工作表,但代码停止运行

编程语言 2026-07-09

我的代码会创建若干公式检查,从一个名为NL20的选项卡开始。

    Dim ws          As Worksheet
    Set ws = wb.Worksheets("NL20")
'my code running here, creating formula checks

在对工作表NL20进行公式检查结束后,我希望它能够检查是否存在工作表NL21和/或工作表US12,并在这些标签页上创建类似的公式。若不存在NL21和/或US12,这段代码应停止运行。下面是NL20选项卡完成后的检查。它可以正确地找到每个选项卡的名称,但在对两者执行完函数后,代码就会跳出。不是结束;如果它找到了NL21,我希望在它上面继续运行我的公式检查,US12标签页也同样如此。

    If Not (SheetExists("NL21") Or SheetExists("US12")) Then
        MsgBox "NL21 or US12 missing. Code stopped.", vbExclamation
        Exit Sub
    End If
'my code here

End Sub

Function SheetExists(SheetName As String) As Boolean
    On Error Resume Next
    SheetExists = Not ThisWorkbook.Worksheets(SheetName) Is Nothing
    On Error GoTo 0
End Function

以下是我更新后的代码:

    'Select template for review
    Dim myFileName  As Variant
    myFileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*")
    If myFileName = False Then Exit Sub
    Dim wb          As Workbook
    Set wb = Workbooks.Open(Filename:=myFileName)
    Dim ws          As Worksheet
    Set ws = wb.Worksheets("NL20")



'Stackoverflow code
Dim item, formularesult
arr1 = Array("NL20", "NL21", "US12")

For Each item In arr
    On Error Resume Next
    If Not Worksheets(item).Type = xlWorksheet Then
        MsgBox "One sheet is missing", vbCritical
        Exit Sub
    End If
Next item
On Error GoTo 0

For Each item In arr
    formularesult = formulafunction(item)
    'do something with formularesult
Next item

'Find critical headers
    Dim wsHeader_Row As Long
    wsHeader_Row = 2
    Dim wsFind_Last_Row As Long
    wsFind_Last_Row = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    Dim wsFind_Last_Column As Long
    wsFind_Last_Column = ws.Cells(wsHeader_Row, ws.Columns.Count).End(xlToLeft).Column

'Then the code continues on and creates my formulas for sheet NL20
'Finally your function after the end sub

'Stackoverflow
Function formulafunction(sheet As Variant) As Variant

Dim ws As Worksheet, wb As Workbook
Set wb = ActiveWorkbook
Set ws = wb.Worksheets(sheet)
'checking formula the returned formulafunction can be anything e.g. True or False or text "Succeed"/"Failed"
result = "Succeed"
formulafunction = result

End Function

' 这里是我的代码开始

Sub Checks()
'

' Optional close book1
    On Error Resume Next
    Workbooks("Book1.xlsx").Close SaveChanges:=False
    On Error GoTo 0

'Close Book1
    ActiveWorkbook.Close

'Select template for review
    Dim myFileName  As Variant
    myFileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*")
    If myFileName = False Then Exit Sub
    Dim wb          As Workbook
    Set wb = Workbooks.Open(Filename:=myFileName)
    Dim ws          As Worksheet
    Set ws = wb.Worksheets("NL20")

'Check Which Sheets are in the Template
    Dim wb As Workbook, ws As Worksheet, sht

    Set wb = ThisWorkbook

    For Each sht In Array("NL20", "NL21", "US12")
        Set ws = WorksheetIfFound(wb, sht)
        If Not ws Is Nothing Then
            'run checks on sheet `ws`
        End If
    Next sht

解决方案

如果所有工作表的公式检查都相同,我会这样做:

Option Explicit

Sub RunAllChecks()
    Dim wb As Workbook, ws As Worksheet, sht
    Dim myFileName  As Variant

    ' Optional close book1
    On Error Resume Next
    Workbooks("Book1.xlsx").Close SaveChanges:=False
    On Error GoTo 0

    'Close Book1
    ActiveWorkbook.Close

    'Select template for review    
    myFileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*")
    If myFileName = False Then Exit Sub

    Set wb = Workbooks.Open(Filename:=myFileName)

    For Each sht In Array("NL20", "NL21", "US12")
        Set ws = WorksheetIfFound(wb, sht)
        If Not ws Is Nothing Then
            RunFormulaChecks ws 'run checks on sheet `ws`
        End If
    Next sht
End Sub

'Perform some checks/validations on worksheet `ws`
Sub RunFormulaChecks(ws As Worksheet)
    Const ROW_HEADER As Long = 2

    Dim lastRow As Long, lastCol As Long

    'find last row and column
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    lastCol = ws.Cells(ROW_HEADER, ws.Columns.Count).End(xlToLeft).Column

    'Rest of your formula-checking code goes here, always
    '   working with `ws`

End Sub

'Return worksheet named `sheetName` from workbook `wb`
'  Ignore any error, and return Nothing if the sheet doesn't exist
Function WorksheetIfFound(wb As Workbook, sheetName) As Worksheet
    On Error Resume Next
    Set WorksheetIfFound = wb.Worksheets(sheetName)
    Debug.Print "Sheet '" & sheetName & "'" & _
                IIf(WorksheetIfFound Is Nothing, " not", "") & _
                " found in workbook '" & wb.Name & "'"
End Function
站内所有文章版权归属LeftHeroAI导航站,无授权禁止任何主体转载、抄袭、复制内容,亦不得私自架设镜像站点。一经侵权,本站将通过法律途径追责。

相关文章