为什么 "bCheck" 总是 return "True"?

Why does "bCheck" always return "True"?

我一直在研究 Macro,它会在 Calendar Year 更改时自动添加新的 Annual Worksheets。我目前的Code如下:

Option Explicit

Sub addAnnualWkst()

Dim ws As Worksheet
Dim wsM As Worksheet
Dim strName As String
Dim strNamePreYr As String
Dim bCheck As Boolean
Dim pID As String
Dim rw

Set propIDs = ThisWorkbook.Names("propIDs").RefersToRange
Set actStatus = ThisWorkbook.Names("actStatus").RefersToRange

On Error Resume Next
Set wsM = Worksheets("WkstMaster")
    For rw = 1 To propIDs.Count
        If propIDs.Cells(rw, 1).Value2 <> vbNullString Then
            If actStatus.Cells(rw, 1).Value2 = True Then
              pID = propIDs.Cells(rw, 1).Value2
              strName = pID & "_" & (Format(Date, "yyyy"))
              strNamePreYr = pID & "_" & (Format(Date, "yyyy") - 1)
              bCheck = Len(Sheets(strName).Name) > 0
              Debug.Print pID, strName, strNamePreYr, bCheck
                If bCheck = False Then
                'add new sheet after Previous Year's Worksheet
                    wsM.Copy After:=Sheets(strNamePreYr)
                    ActiveSheet.Name = strName
                End If
            End If
        End If
    Next
Set wsM = Nothing
End Sub

上面的代码部分基于我在 Tutorial 中找到的 Macro 我发现 Module Code 是:

Option Explicit

Sub AddMonthWkst()
Dim ws As Worksheet
Dim wsM As Worksheet
Dim strName As String
Dim bCheck As Boolean

On Error Resume Next
Set wsM = Sheets("Wkst_Master")
strName = Format(Date, "yyyy_mm")
bCheck = Len(Sheets(strName).Name) > 0

If bCheck = False Then
'add new sheet after Instructions
    wsM.Copy After:=Sheets(1)
    ActiveSheet.Name = strName
End If

Set wsM = Nothing
End Sub

以上 'code' 与宣传的一样有效! bCheck returns False 并添加了新工作表。我可以将工作表选项卡从当前月份 05 重命名为上个月 04,保存并关闭工作簿,当我重新打开工作簿时,会自动添加一个新工作表 05 延长一个月。

我稍微修改了代码以满足我的需要并将该代码封装在 subroutine 我成功地在应用程序的不同部分使用 select pIDs 基于 actStatus.

我为各种 PropIDs 启用了 Worksheet Tabs,如图所示:

当我 运行 Macro Immediate Window 显示 ALL Active pIDspCheck Value 作为 TruepID "Rev" 应该 return 值 False 因为 pID "Rev" 没有当前年份的 WorkSheet! 正如下面的 Immediate window 屏幕截图所示,所有相关的 pIDs 都在那里!

如果我禁用 'On Error Resume Next' 行,我会收到 Runtime Error: 9, Script out of range 错误,无论有无 Error Trap 都不会添加工作表。 Error 发生在 codehighlighted 行。

请帮我解决这个问题。我知道这是我想念的简单事情! 提前致谢。

这是你的问题:

Sub TesterLoop()
    Dim bCheck As Boolean, s
    
    On Error Resume Next
    'Sheet4 doesn't exist
    For Each s In Array("Sheet1", "Sheet2", "Sheet4")
        'if the next line has an error then the value of bCheck is *unchanged*
        bCheck = Len(ThisWorkbook.Sheets(s).Name) > 0
        Debug.Print s, bCheck
    Next s
End Sub

输出:

Sheet1        True
Sheet2        True
Sheet4        True   '<<<oops!  Still has the Sheet2 value...

bCheck 的值只能在该行执行无错误时设置:如果有错误,则 bCheck 仍然具有其初始 False 值,或者来自上一个循环迭代。

如果你添加

bCheck = False

在该行之前,它将解决您的问题。

但是On Error Resume Next覆盖你的大部分代码是个坏主意,你最好把检查分解成一个独立的函数作为在评论中建议。

感谢那些为我指明可能的解决方案方向的人。

这是我想出的解决方案!

Sub addAnnualWkst()

Dim ws As Worksheet
Dim wsM As Worksheet
Dim strName As String
Dim strNamePreYr As String
Dim bCheck As Boolean
Dim exists
Dim pID As String
Dim rw

Set propIDs = ThisWorkbook.Names("propIDs").RefersToRange
Set actStatus = ThisWorkbook.Names("actStatus").RefersToRange

Set wsM = Worksheets("WkstMaster")
    For rw = 1 To propIDs.Count
        If propIDs.Cells(rw, 1).Value2 <> vbNullString Then
            If actStatus.Cells(rw, 1).Value2 = True Then
              pID = propIDs.Cells(rw, 1).Value2
              cName = pID & (Format(Date, "yyyy"))
              strName = pID & "_" & (Format(Date, "yyyy"))
              strNamePreYr = pID & "_" & (Format(Date, "yyyy") - 1)
                If Not wsExists(strName) Then
                Debug.Print pID, strName, strNamePreYr
                  wsM.Copy After:=Sheets(strNamePreYr)
                  ActiveSheet.Name = strName
                End If
            End If
        End If
    Next
Set wsM = Nothing
End Sub
Function wsExists(strName As String) As Boolean
    Dim ws: For Each ws In ThisWorkbook.Sheets
    wsExists = (strName = ws.Name): If wsExists Then Exit Function
    Next ws
End Function

唯一出现在 Immediate Window 中的 'pID' 是缺少 2022 扩展名的 pID