1

私はExcelでVBAを使用してテストレポートデータベースを作成しています。ドキュメント番号を探してセルを参照すると、エラーが発生しますscript out of range (Error 9)。

私が使用しているコードは次のとおりです。

LookUpRowCounter = HeaderRow + 1
    Do Until Workbooks(DBName).Worksheets("List").Cells(LookUpRowCounter, 1).Text = ""
        If Workbooks(DBName).Worksheets("List").Cells(LookUpRowCounter, 1).Text = DocumentNumber Then
            Exit Do
        End If
        LookUpRowCounter = LookUpRowCounter + 1
    Loop

エラーは、最初のレコードのIfステートメントで発生します。ここで、カウンターは5です。データシート「リスト」には、5行目から15行目までの10個のレコードがあります。

助けてくれてありがとう

編集

文書番号の形式は0000AA000で、数字と大文字が含まれています。

Public Sub Archive()
'On Error GoTo Err

Dim DocumentNumber As String
Dim ProjectNumber As Single

Dim DBName As String
Dim DBLocation As String

Dim LookUpRowCounter As Single

Application.ScreenUpdating = False

DBName = "Attribute DataSheet.xls"
DBLocation = "J:\home\PEJ2WO\Database For Martin\"

DocumentNumber = ThisWorkbook.Sheets("Detail and Summary").Range("infDocumentNumber").Text


Workbooks.Open Filename:=DBLocation & DBName

If Not DocumentNumber = "" Then

'Document number present
    LookUpRowCounter = HeaderRow + 1
    Do Until Workbooks(DBName).Worksheets("List").Cells(LookUpRowCounter, 1).Text = DocumentNumber
    If Workbooks(DBName).Worksheets("List").Cells(LookUpRowCounter, 1).Text = "" Then Exit Do
        LookUpRowCounter = LookUpRowCounter + 1
    Loop

Else

'create new document number
    DocumentNumber = GetDocumentNumbers(DocumentNumber)


    ThisWorkbook.Sheets("Detail and Summary").Unprotect (Password)
    ThisWorkbook.Sheets("Detail and Summary").Range("infDocumentNumber").Value = DocumentNumber
    'ThisWorkbook.Sheets("Detail And Summary").Range("infProjectNumber").Value = ProjectNumber
    ThisWorkbook.Sheets("Detail And Summary").Protect (Password)

    LookUpRowCounter = HeaderRow + 1
    Do Until Workbooks(DBName).Worksheets("List").Cells(LookUpRowCounter, 1).Text = ""
        If Workbooks(DBName).Worksheets("List").Cells(LookUpRowCounter, 1).Text = DocumentNumber Then
            Exit Do
        End If
        LookUpRowCounter = LookUpRowCounter + 1
    Loop

End If

この時点以降、要約シートに値を書き込むためのコードがありますが、これは長く巻き込まれているため、関連付ける必要はありません。

4

1 に答える 1

3

エラー 9 は、存在しないインデックスによってコレクションのメンバーを取得しようとしたことを示します。コードの多くの場所で、ハードコーディングされた名前で Workbook、Worksheet、および Range オブジェクトを取得しようとしています。これらの少なくとも 1 つが存在すると思っていても存在しないため、エラーが発生しています。

次の関数を使用して参照を安全に取得し、メンバーが存在しない場合は適切に処理してみてください。

TryGetItem

Function TryGetItem(ByVal Collection As Object, ByVal Index, ByRef Value) As Boolean
On Error GoTo ErrSub

    If IsObject(Collection(Index)) Then
        Set Value = Collection(Index)
    Else
        Value = Collection(Index)
    End If
    TryGetItem = True
    Exit Function

ErrSub:
    If Err.Number = 9 Then
        Err.Clear
        TryGetItem = False
    Else
        ' Propogate error
        Err.Raise Err.Number, , Err.Description
    End If
End Function

これを使用して既存のメソッドを更新する方法は次のとおりです。

Public Sub Archive()

    Dim DocumentNumber As String
    Dim ProjectNumber As Single
    Dim DBName As String
    Dim DBLocation As String
    Dim LookUpRowCounter As Single

    ' New variables:
    Dim wsDetail As Worksheet
    Dim rngDocNumber As Range
    Dim wbDatasheet As Workbook
    Dim wsList As Worksheet

    Application.ScreenUpdating = False

    DBName = "Attribute DataSheet.xls"
    DBLocation = "J:\home\PEJ2WO\Database For Martin\"

    If Not TryGetItem(ThisWorkbook.Sheets, "Detail and Summary", wsDetail) Then
        MsgBox "Worksheet 'Detail and Summary' does not exist"
    End If

    If Not TryGetItem(wsDetail.Names, "infDocumentNumber", rngDocNumber) Then
        MsgBox "Named range 'infDocumentNumber' does not exist"
    End If

    DocumentNumber = rngDocNumber.Text

    Set wbDatasheet = Workbooks.Open(DBLocation & DBName)

    If DocumentNumber <> "" Then

        If Not TryGetItem(wbDatasheet.Worksheets, "List", wsList) Then
            MsgBox "Worksheet 'List' does not exist"
        End If

        'Document number present
        LookUpRowCounter = HeaderRow + 1
        Do Until wsList.Cells(LookUpRowCounter, 1).Text = DocumentNumber
            If wsList.Cells(LookUpRowCounter, 1).Text = "" Then Exit Do
            LookUpRowCounter = LookUpRowCounter + 1
        Loop

    Else

        'create new document number
        DocumentNumber = GetDocumentNumbers(DocumentNumber)

        wsDetail.Unprotect Password
        rngDocNumber.Value = DocumentNumber
        wsDetail.Protect Password

        LookUpRowCounter = HeaderRow + 1
        Do Until wsList.Cells(LookUpRowCounter, 1).Text = ""
            If wsList.Cells(LookUpRowCounter, 1).Text = DocumentNumber Then Exit Do
            LookUpRowCounter = LookUpRowCounter + 1
        Loop

    End If

    Application.ScreenUpdating = True

End Sub
于 2013-03-18T13:28:39.570 に答える