处理 vba 数组中输入错误的日期答案

【问题标题】：Dealing with a mis-typed date in a vba array处理 vba 数组中输入错误的日期
【发布时间】：2014-01-21 20:17:15
【问题描述】：

我编写了一些从 lotus notes 数据库中提取数据并将其写入变量类型数组的代码。我现在的问题是我无法将该数组写入 excel 范围。我收到“应用程序定义或对象定义错误”。我想我知道为什么：

有人在 lotus notes 数据库中输入错误的日期。他们没有输入“07/08/2011”，而是输入了“07/08/0211”。因此，数组中的一个元素包含存储为日期子类型的“07/08/0211”。当我尝试将数组写入范围时，只复制了数组的一部分。我收到错误，并且拼写错误后数组中的所有内容都被切断。

我并不真正关心更正日期，我只需要找到一种方法来忽略它并将数组的全部内容复制到电子表格中。

提前感谢您的帮助！

Sub DRupdate()

    Dim db As Object
    Dim doc As Object
    Dim session As New NotesSession
    Dim view As Object

    Dim row As Long
    Dim arr_1(1 To 2) As Variant
    Dim arr_2() As Variant
    Dim LastUpdated As String
    Dim EccLastRow As Range

    Dim item_values(50000, 4) As Variant
    Dim password As String
    Dim query As String
    Dim j As Long

    password = "xxxx"

    'intitialize lotus notes session using user-supplied password
    session.Initialize (password)

    'Set variable equal to date of last update stored on the "config" worksheet
    LastUpdated = config.Range("C5").Value


    'Acess ECC database, Emergency ECC view
    Set db = session.GetDatabase("xxxx", "xxxx")
    Set view = db.GetView("xxxx")

    row = 0

    'Create query to search for documents that have "YR" in apparatus field, and have a creation date on or after the last time the workbook was updated
    query = "[_CreationDate]>=" & LastUpdated

    j = view.FTSearch(query, 0)

    Set doc = view.GetFirstDocument

    'On Error GoTo Errhandler

    'Get item values of interest from database and write to the item_values array
    Do
        item_values(row, 0) = doc.GetItemValue("DftgReqNo_1")(0)
        item_values(row, 1) = doc.GetItemValue("TypeWorkReq")(0)
        item_values(row, 2) = doc.GetItemValue("OrigDate")(0)
        item_values(row, 3) = doc.GetItemValue("ReqCompDate")(0)

        If item_values(row, 2) <> "" And item_values(row, 3) <> "" Then

            item_values(row, 4) = DateDiff("d", item_values(row, 2), item_values(row, 3))
        Else
            item_values(row, 4) = "N/A"
        End If

        row = row + 1

        Set doc = view.GetNextDocument(doc)
    Loop While Not (doc Is Nothing)


    With DRdata

        'Append new data to end of ecc table
        .Range(.Range("A999999").End(xlUp).Offset(1, 0), .Range("A999999").End(xlUp).Offset(5000, 3)) = item_values

        'Delete any duplicates
        .Range("A1", .Range("A1").End(xlDown).Offset(0, 3)).RemoveDuplicates Columns:=Array(1), Header:=xlYes

     End With

    'Write date of last update onto "config" sheet
    config.Range("C5").Value = Date

Errhandler:

        Select Case Err

            Case 91:
                MsgBox ("Drafting Request data is up to date")

        End Select

End Sub

【问题讨论】：

你能显示一些代码吗？
我添加了代码，但我认为唯一的问题是当我将数组写入“With DRdata”块中的范围时。
DRdata 是工作表的 vba 代号。我确信问题出在数组中输入错误的日期，因为大多数数组确实被打印到范围内。它只是在遇到拼写错误时被切断。
但是你在哪里定义的呢？
我只是在属性窗口中更改了代号属性msdn.microsoft.com/en-us/library/office/…

标签： arrays excel vba date runtime-error

【解决方案1】：

通过如下修改代码解决了问题：

 Do
    item_values(row, 0) = Cstr(doc.GetItemValue("DftgReqNo_1")(0))
    item_values(row, 1) = Cstr(doc.GetItemValue("TypeWorkReq")(0))
    item_values(row, 2) = Cstr(doc.GetItemValue("OrigDate")(0))
    item_values(row, 3) = Cstr(doc.GetItemValue("ReqCompDate")(0))

    If item_values(row, 2) <> "" And item_values(row, 3) <> "" Then

        item_values(row, 4) = Cstr(DateDiff("d", item_values(row, 2),item_values(row,3)))
    Else
        item_values(row, 4) = "N/A"
    End If

    row = row + 1

    Set doc = view.GetNextDocument(doc)
Loop While Not (doc Is Nothing)

【讨论】：