Question

我在excel中使用VBA来创建一个testreport数据库。当我引用一个寻找文档编号的单元格时，我收到错误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语句中，其中counter = 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

在此之后，只有代码将值写入摘要表，这是冗长的，不应该相关。

Answer 1

错误9表示您尝试通过不存在的索引获取集合的成员。在代码中的许多地方，您试图通过硬编码名称获取Workbook，Worksheet和Range对象。即使你认为它们中至少有一个不存在，所以你得到了错误。

尝试使用以下函数安全地尝试获取引用，并在成员不存在时正常处理它：

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

引用单元格时出错9

1 个答案:

TryGetItem