使用VBA将错误单元格分隔到另一个工作表

最近我尝试将错误单元格分隔到另一个工作表，并恢复程序。 运行时错误“1004”通常发生在shtOut.Cells(2, 1).Resize(r2, 3).Value = arrOut ，这个错误是由第3列中的值引起的。

  Sub Merge_desc() Dim shtIn As Worksheet, shtOut As Worksheet, errout As Worksheet Dim arrIn Dim arrOut Dim ub As Long, r As Long, r2 As Long Dim num Dim order Dim desc Dim syalala Set shtIn = ThisWorkbook.Sheets("Control Deck") Set shtOut = ThisWorkbook.Sheets("Process") Set errout = ThisWorkbook.Sheets("error") 'load the input data to an array arrIn = shtIn.Range(shtIn.Range("A1"), shtIn.Cells(Rows.Count, 3).End(xlUp)).Value ub = UBound(arrIn, 1) 'resize the output array to match ReDim arrOut(1 To ub, 1 To 3) r2 = 1 For r = 1 To ub ' start of a new item If Len(arrIn(r, 1)) > 0 Then 'output any previous item to the second array If Len(num) > 0 Then arrOut(r2, 1) = num arrOut(r2, 2) = order arrOut(r2, 3) = desc r2 = r2 + 1 End If 'store the current item info num = arrIn(r, 1) order = arrIn(r, 2) desc = arrIn(r, 3) Else 'still on the same item, so add to the description desc = desc & arrIn(r, 3) End If Next r 'add the last item... If Len(num) > 0 Then arrOut(r2, 1) = num arrOut(r2, 2) = order arrOut(r2, 3) = desc End If 'add header shtOut.Cells(1, 1).Resize(1, 3).Value = _ Array("Material Number", "Short Description", "Long Description") y = 1 'dump the output array to the worksheet shtOut.Cells(2, 1).Resize(r2, 3).Value = arrOut If IsError(arrOut) Then Do While errout.Cells(y, 1).Value = "" shtOut.Cells(2, 1).Resize(r2, 3).Cut errout.Cells(y, 1).Paste y = y + 1 Loop End If End Sub 

我加

  If IsError(arrOut) Then Do While errout.Cells(y, 1).Value = "" shtOut.Cells(2, 1).Resize(r2, 3).Cut errout.Cells(y, 1).Paste y = y + 1 Loop End If 

并希望这有效，但事实并非如此。 哈哈。 我很确定我做错了。 如何使其正确？

---

更新我已经尝试了L42build议。

  On Error Resume Next 'this line does what it say's shtOut.Cells(2, 1).Resize(r2, 3).Value = arrOut 'this line is what you suspect to have error On Error GoTo 0 'this is the "Next" line after the error which resets the error and allows you to handle it If IsEmpty(shtOut.Cells(2, 1).Resize(r2, 3)) Then 'assuming this range is empty to start with shtOut.Cells(2, 1).Resize(r2, 3).Value.Cut Do While errout.Cells(y, 3).Value = "" errout.Cells(y, 1).Paste y = y + 1 Loop '~~> you put your error handling here End If 

但没有发生。 ：|

Answer 1

下面是简历的一个简单的演示：

 On Error Resume Next 'this line does what it say's shtOut.Cells(2,1).Resize(r2,3).Value = arrOut 'this line is what you suspect to have error On Error Goto 0 'this is the "Next" line after the error which resets the error and allows you handle it. With Application.WorksheetFunction If .CountA(shtOut.Cells(2,1).Resize(r2,3)) = 0 Then '~~> your code here End If End With 

再一次，我假设你的目标范围是空的，然后再执行代码，只有当你成功通过arrOut才会填充。