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 和通信
我的代码似乎 运行 第一次没有问题(添加新作业)->(创建),但崩溃第二个 运行,它会抛出 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 运行时不会产生错误
我目前正在处理的 VBA 项目有问题,特别是 run-time 错误,一段代码在底部找到下一个空单元格table 并将存储的字符串写入该范围
现在 - 对该项目的快速解释。我在 Excel sheet 中有一个 table,它记录了我工作的公司可能拥有的每个潜在工作 coming-up。为此,我有一个 front-end 可以控制 creating/reviewing 新的 "Jobs" 或 "Opportunities",运行 的代码在这里做了一些 sense-checking的信息,在网络驱动器上为联系人和合同信息创建一个标准化的文件夹结构,并为工作生成一个唯一的 ID,然后将用于我们的 CRM 和通信
我的代码似乎 运行 第一次没有问题(添加新作业)->(创建),但崩溃第二个 运行,它会抛出 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 运行时不会产生错误