Question

最近我尝试将错误单元格分离到另一个工作表，然后恢复该程序。运行时错误'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

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

更新我试过l42建议。

    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后才会填充。

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

1 个答案: