[已解决]求助，代码是否有误？

新一

工作表：表三，为何不在总工序表中显视出来，是否代码有误，求帮助。

最佳答案

月排行榜 / 总排行榜

dsmch

2014-3-25 19:16

Sub Macro2()
On Error Resume Next
Dim arr, brr, crr(1 To 16, 1 To 8)
Dim n&, k%, j&, i&, s&
Range("a3:h65536").ClearContents
n = 3
For k = 5 To 6
    arr = Sheets(k).UsedRange
    For i = 2 To UBound(arr)
        If InStr(arr(i, 1), "对应单号") And Len(arr(i, 1)) > 5 Then
            brr = Sheets(k).Cells(i, 1).Resize(16, 8)
            y = Val(brr(1, 6)): m = Val(brr(1, 7)): r = Val(brr(1, 8))
            rq = DateSerial(y, m, r)
            dh = Mid(brr(1, 1), 6)
            mc = Mid(brr(2, 1), 4)
            s = 0
            For j = 4 To UBound(brr)
                If brr(j, 2) <> "" Then
                    s = s + 1
                    crr(s, 1) = rq
                    crr(s, 2) = dh
                    crr(s, 3) = mc
                    crr(s, 4) = brr(j, 2)
                    crr(s, 5) = brr(j, 5)
                    crr(s, 6) = brr(j, 6)
                    crr(s, 7) = brr(j, 7)
                    crr(s, 8) = brr(j, 3)
                End If
            Next
            Cells(n, 1).Resize(s, UBound(crr, 2)) = crr
            n = n + s
        End If
    Next
Next
x = Sheets(7).Range("a65536").End(xlUp).Row
If x < 3 Then Exit Sub
Sheets(7).Range("a3:h" & x).Copy Cells(n, 1)
End Sub

跳转到最佳答案楼层

dsmch

建议详细说明要求，并示意结果

新一

dsmch 发表于 2014-3-25 18:23
建议详细说明要求，并示意结果

进仓，调拨，表三，三个明的数据在总工序表中显视出来。

dsmch

Sub Macro2()
On Error Resume Next
Dim arr, brr, crr(1 To 16, 1 To 8)
Dim n&, k%, j&, i&, s&
Range("a3:h65536").ClearContents
n = 3
For k = 5 To 6
    arr = Sheets(k).UsedRange
    For i = 2 To UBound(arr)
        If InStr(arr(i, 1), "对应单号") And Len(arr(i, 1)) > 5 Then
            brr = Sheets(k).Cells(i, 1).Resize(16, 8)
            y = Val(brr(1, 6)): m = Val(brr(1, 7)): r = Val(brr(1, 8))
            rq = DateSerial(y, m, r)
            dh = Mid(brr(1, 1), 6)
            mc = Mid(brr(2, 1), 4)
            s = 0
            For j = 4 To UBound(brr)
                If brr(j, 2) <> "" Then
                    s = s + 1
                    crr(s, 1) = rq
                    crr(s, 2) = dh
                    crr(s, 3) = mc
                    crr(s, 4) = brr(j, 2)
                    crr(s, 5) = brr(j, 5)
                    crr(s, 6) = brr(j, 6)
                    crr(s, 7) = brr(j, 7)
                    crr(s, 8) = brr(j, 3)
                End If
            Next
            Cells(n, 1).Resize(s, UBound(crr, 2)) = crr
            n = n + s
        End If
    Next
Next
x = Sheets(7).Range("a65536").End(xlUp).Row
If x < 3 Then Exit Sub
Sheets(7).Range("a3:h" & x).Copy Cells(n, 1)
End Sub