在工作簿中找到了工作表,但代码停止运行
我的代码会创建若干公式检查,从一个名为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导航站,无授权禁止任何主体转载、抄袭、复制内容,亦不得私自架设镜像站点。一经侵权,本站将通过法律途径追责。