1

我很困惑。我有一个工作簿,用作部分业务的模板作为注册。用户建立他们正在跟踪的注册项目列表。对于主寄存器中的每个项目,我需要创建一个工作表,以提供有关该问题的更多详细信息。新工作表是工作簿“TemplateCRA”中模板的副本。当在登记表“所有权”中制作或更新所有主菜时,使用单个宏完成创建操作

我从这个开始:

Sub Button1_Click()
'
' Button1_Click Macro
'
    Dim MyCell As Range, MyRange As Range

        Set MyRange = Sheets("Ownership").Range("B11:B30")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))

    For Each MyCell In MyRange
        If IsEmpty(MyCell) Then End
        Sheets("TemplateCRA").Copy After:=Sheets(Sheets.Count) 'creates a new worksheet
        Sheets(Sheets.Count).Name = "CRA Ref " & MyCell.Value ' renames the new worksheet
        Range("B6").Value = ActiveSheet.Name

    Next MyCell
End Sub

然后我继续这样做,以尝试确保宏首先检查尚未为注册项目创建工作表,如果是,则提醒用户,然后继续循环向下项目列表并创建所需的新工作表.

Sub Button2_Click()
    '
    ' Button2_Click Macro
    '
    Dim MyCell As Range, MyRange As Range
    Dim sh As Worksheet, flg As Boolean
    Set MyRange = Sheets("Ownership").Range("B11:B30")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))
    For Each MyCell In MyRange
            If IsEmpty(MyCell) Then End

            For Each sh In Worksheets
                If sh.Name Like "CRA Ref " & MyCell.Value Then flg = True: Exit For
            Next
            If flg = True Then
                MsgBox sh.Name & " Found!"
            ElseIf flg = False Then
                MsgBox "Creating CRA Ref " & MyCell.Value & " now!"
                Sheets("TemplateCRA").Copy After:=Sheets(Sheets.Count) 'creates a new worksheet
                Sheets(Sheets.Count).Name = "CRA Ref " & MyCell.Value ' renames the new worksheet
                Range("B6").Value = ActiveSheet.Name
            End If

    Next MyCell
    MsgBox "You may now complete your CRA for each item"
End Sub

但这不能正常工作。似乎发生的是:

sh.Name 检查循环通过 OK 报告找到工作表,直到找到没有工作表的项目 Run Time error 91 - object variable with block variable not set 在第一个 MsgBox 行中报告 a。

谁能建议我有什么问题?

干杯

4

2 回答 2

2

四件事

  1. 请避免使用End. 看到这个链接
  2. 使用xlDown来查找最后一行可能非常冒险。请参阅此链接以了解 @brettdj 如何解释它。
  3. 有关如何获取最后一行的信息,请参阅此链接。
  4. 您只需几行即可检查工作表是否存在。不需要循环工作表。

我没有测试过代码,但它应该可以工作。如果您收到任何错误,请告诉我是哪一行给您错误,我们将从那里处理。

Sub Button1_Click()
    Dim ws As Worksheet, wsTemp As Worksheet
    Dim MyCell As Range, MyRange As Range
    Dim LRow As Long

    Set ws = ThisWorkbook.Sheets("Ownership")

    With ws
        LRow = .Range("B" & .Rows.Count).End(xlUp).Row

        Set MyRange = .Range("B11:B" & LRow)

        For Each MyCell In MyRange
            If Len(Trim(MyCell.Value)) <> 0 Then
                On Error Resume Next
                Set wsTemp = ThisWorkbook.Sheets("CRA Ref " & MyCell.Value)
                On Error GoTo 0

                If wsTemp Is Nothing Then '<~~ Sheet doesn't exists
                    ThisWorkbook.Sheets("TemplateCRA").Copy After:=ThisWorkbook.Sheets(Sheets.Count)
                    ThisWorkbook.Sheets(Sheets.Count).Name = "CRA Ref " & MyCell.Value
                Else '<~~ Sheet exists
                    MsgBox "sheet exists"
                End If

                set wsTemp = nothing

            End If
        Next MyCell
    End With
End Sub
于 2013-01-24T09:04:05.777 回答
2

问题是你没有flg在外部 for 循环中初始化你的。因此,对于第2个循环,默认值为flgTRUE,它循环通过内部for each循环并且找不到sh,sh-->空-->runtime error

修复您的代码:

Sub Button2_Click()
    '
    ' Button2_Click Macro
    '
    Dim MyCell As Range, MyRange As Range
    Dim sh As Worksheet, flg As Boolean
    Set MyRange = Sheets("Ownership").Range("B11:B30")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))
    For Each MyCell In MyRange
            If IsEmpty(MyCell) Then
               exit for
            end if
            flg = False ' init the flg each time
            For Each sh In Worksheets
                'Changed Like --> = to ensure the worksheet exists
                If sh.Name = "CRA Ref " & MyCell.Value Then
                    flg = True
                    Exit For
                End If
            Next
            If flg = True Then
                MsgBox sh.Name & " Found!"
            ElseIf flg = False Then
                MsgBox "Creating CRA Ref " & MyCell.Value & " now!"
                Sheets("TemplateCRA").Copy After:=Sheets(Sheets.Count) 'creates a new worksheet
                Sheets(Sheets.Count).Name = "CRA Ref " & MyCell.Value ' renames the new worksheet
                Range("B6").Value = ActiveSheet.Name
            End If

    Next MyCell
    MsgBox "You may now complete your CRA for each item"
End Sub
于 2013-01-24T06:30:09.283 回答