1

我在 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 语句中，其中计数器 =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 对象。即使您认为其中至少一个不存在，所以您会收到错误消息。

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

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 回答