Excel VBA: Run-time 错误(对象 'Range' 的方法 'Value' 失败),但仅在连续运行时

Excel VBA: Run-time error (Method 'Value' of object 'Range' failed), but only on consecutive runs

我目前正在处理的 VBA 项目有问题,特别是 run-time 错误,一段代码在底部找到下一个空单元格table 并将存储的字符串写入该范围

现在 - 对该项目的快速解释。我在 Excel sheet 中有一个 table,它记录了我工作的公司可能拥有的每个潜在工作 coming-up。为此,我有一个 front-end 可以控制 creating/reviewing 新的 "Jobs" 或 "Opportunities",运行 的代码在这里做了一些 sense-checking的信息,在网络驱动器上为联系人和合同信息创建一个标准化的文件夹结构,并为工作生成一个唯一的 ID,然后将用于我们的 CRM 和通信

dashboard

我的代码似乎 运行 第一次没有问题(添加新作业)->(创建),但崩溃第二个 运行,它会抛出 run-time 错误 '-2147417848(80010108)':对象 'Range' 的方法 'Value' 失败。在行:

r.Value = pFix

和Excel(2016 on Windows 10)会崩溃并重启

编辑: 我认为这可能是因为 r 没有在第二个 运行 上正确存储 - 或者可能不是第一次后正确地从内存中清除。但是我已经尝试 Set r = Nothing 并且我读到的内容 here 表明这无论如何都不是问题

此代码取自 UserForm frmNewJob 上的 Button_Click 事件(屏幕截图中显示的输入表单)

Private Sub CommandButton1_Click()
    Dim pFix As String
    Dim sNew As Long
    Dim jNumber As String
    Dim jName As String
    Dim jIndex As String
    Dim jClient As String
    Dim jSite As String
    Dim jComments As String
    Dim cName As String
    Dim createdDate As Date
    Dim r As Range
    Dim hLink As String
    Dim hLink2 As String
    Dim wDir As String
    Dim msg As String
    Dim ans As String

    Set r = Nothing


    wDir = ActiveWorkbook.Path

    If TextBox1.Value = "" Then
        Call MsgBox("Please enter a valid Requester Name", vbCritical)
        Exit Sub
    Else

        If TextBox2.Value = "" Then
            Call MsgBox("Please enter a valid Client Name", vbCritical)
            Exit Sub
        Else

            If TextBox3.Value = "" Then
                Call MsgBox("Please enter a valid Site Description", vbCritical)
                Exit Sub
            Else

            End If
        End If
    End If

    pFix = "GSM"
    sNew = WorksheetFunction.Max(Columns(2)) + 1
    jNumber = pFix & sNew
    jClient = TextBox2.Value
    jIndex = Left(jClient, 1)
    jSite = TextBox3.Value
    jName = jClient & " - " & jSite
    jComments = TextBox4.Value
    cName = TextBox1.Value
    createdDate = Now


    Set r = Sheet1.Range("A" & Rows.Count).End(xlUp).Offset(1)

    r.Value = pFix
    r.Offset(0, 1) = sNew
    r.Offset(0, 2) = jNumber
    r.Offset(0, 3) = jName
    r.Offset(0, 4) = jComments
    r.Offset(0, 5) = createdDate
    r.Offset(0, 6) = cName

    Call MsgBox("New Job Number is: " & jNumber, vbOKOnly)

    On Error Resume Next
    hLink = wDir & "\" & jIndex
    MkDir hLink

    hLink = hLink & "\" & jNumber & " - " & jName
    MkDir hLink

    hLink2 = hLink & "\" & "1. Tender Documents"
    MkDir hLink2

    hLink2 = hLink & "\" & "2. Clarifications and Addendums"
    MkDir hLink2

    hLink2 = hLink & "\" & "3. Client Correspondence and MoU's"
    MkDir hLink2

    hLink2 = hLink & "\" & "4. Technical Queries"
    MkDir hLink2

    hLink2 = hLink & "\" & "5. Document Register"
    MkDir hLink2

    hLink2 = hLink & "\" & "6. Subcontractor and Material Pricing"
    MkDir hLink2

    hLink2 = hLink & "\" & "7. Estimate"
    MkDir hLink2

    hLink2 = hLink & "\" & "8. Photos"
    MkDir hLink2

    hLink2 = hLink & "\" & "9. Tender Submission"
    MkDir hLink2

    hLink2 = hLink & "\" & "10. Drawings"
    MkDir hLink2

    hLink2 = hLink & "\" & "11. Post Tender Correspondence"
    MkDir hLink2



    Unload Me

    'Call filterByJobNumber
    Call copyTable

    msg = "Would you like to open the newly created directory?"
    ans = MsgBox(msg, vbYesNo, "Open Directory?")

    If ans = vbYes Then
        Shell "explorer """ & hLink & "", vbNormalFocus
    Else
    End If


End Sub

它正在崩溃 Excel 的事实,而不是仅仅中断并让我调试,这是让我感到震惊的事实 - 而且如果没有失败,它会第一次 运行 但第二次崩溃

编辑: 我已经将范围缩小到 r.Value = pFix 行,这是将存储的 pFix 字符串写入新范围的地方 r.在此行之前弹出 msgbox(pFix) 表明存储了正确的 pFix 字符串,因此错误必须在

范围内

也许一些新鲜的眼睛会发现我忽略的错误 - 了解原因会防止以后重蹈覆辙

编辑 2:

我做了一些进一步的测试,问题肯定发生在代码 运行ning 的第二个实例上,当写入一个值到范围 r 时。我已经创建了一个小测试来强制崩溃,在下面的代码中 Excel 将 lock-up 并在第二个循环中退出 - 它似乎只在 r 的地址更改时发生(行数增加)在每个连续的 运行、 之间并且创建的新行位于 Table 的底部(Excel 会自动将此新行添加到 Table范围)。有人可以 运行 代码并确认他们是否有同样的问题吗?

Sub testMacro()

    Dim r As Range
    Dim str As String

    str = "TEST"
    i = 1

    Do Until i = 5
        Set r = Sheet1.Range("A" & Rows.Count).End(xlUp).Offset(1)
        Call MsgBox(r.Address, vbOKOnly, "Range address for 'r' is")
        r = str
        i = i + 1
    Loop


End Sub

我已尝试 Uninstall/Reinstall 并修复 Office 2016 安装作为附加措施,但它没有帮助。如果不是在其他地方重复table,也许是 Windows 10 怪癖?

回答为 'Community Wiki' 从未回答的问题列表中删除,因为我已经在不更改代码的情况下解决了。

Office 2016/Excel 2016 安装似乎存在一些潜在问题。在进一步的测试中,我确实设法生成了一个 VBA "Out of Memory" 错误,但在这种特殊情况下,对代码的更改似乎没有任何积极影响。

再次(第二次)删除、重新启动和重新安装 Office 似乎已解决问题,而无需对工作簿进行任何其他更改,并且原始 Sub 运行时不会产生错误