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 チェックは Run Time error 91 - object variable with block variable not set 、最初の MsgBox 行にシートが報告されていないアイテムが見つかるまで、シートが見つかったことを報告する OK を繰り返します。

誰かが私が間違っていることを提案できますか?

乾杯

4

2 に答える 2

2

flg問題は、外側の for ループで初期化していないことです。したがって、2 番目のループでは、デフォルト値flgは TRUE であり、内側のfor eachループをループし、sh を見つけることができません。sh --> empty-->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 に答える
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 に答える