[已解决]求助，为何我的总表格式会这样，可否帮帮忙，谢谢。

新一

求助，为何我的总表格式会这样，可否帮帮忙，谢谢。如我的附件

最佳答案

月排行榜 / 总排行榜

dsmch

2014-3-21 18:49

1. Sub Macro1()
   
2. On Error Resume Next
   
3. Dim arr, brr, crr(1 To 16, 1 To 8)
   
4. Dim n&, k%, j&, i&, s&
   
5. Range("a3:h65536").ClearContents
   
6. n = 3
   
7. For k = 1 To 2
   
8.     arr = Sheets(k).UsedRange
   
9.     For i = 2 To UBound(arr)
   
10.         If InStr(arr(i, 1), "对应单号") And Len(arr(i, 1)) > 5 Then
    
11.             brr = Sheets(k).Cells(i, 1).Resize(16, 8)
    
12.             y = Val(brr(1, 6)): m = Val(brr(1, 7)): r = Val(brr(1, 8))
    
13.             rq = DateSerial(y, m, r)
    
14.             dh = Mid(brr(1, 1), 6)
    
15.             mc = Mid(brr(2, 1), 4)
    
16.             s = 0
    
17.             For j = 4 To UBound(brr)
    
18.                 If brr(j, 2) <> "" Then
    
19.                     s = s + 1
    
20.                     crr(s, 1) = rq
    
21.                     crr(s, 2) = dh
    
22.                     crr(s, 3) = mc
    
23.                     crr(s, 4) = brr(j, 2)
    
24.                     crr(s, 5) = brr(j, 5)
    
25.                     crr(s, 6) = brr(j, 6)
    
26.                     crr(s, 7) = brr(j, 7)
    
27.                     crr(s, 8) = brr(j, 3)
    
28.                 End If
    
29.             Next
    
30.             Cells(n, 1).Resize(s, UBound(crr, 2)) = crr
    
31.             n = n + s
    
32.         End If
    
33.     Next
    
34. Next
    
35. x = Sheet3.Range("a65536").End(xlUp).Row
    
36. If x < 3 Then Exit Sub
    
37. Sheet3.Range("a3:h" & x).Copy Cells(n, 1)
    
38. End Sub
    

复制代码

增加纠错处理和判断

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. On Error Resume Next
   
3. Dim arr, brr, crr(1 To 16, 1 To 8)
   
4. Dim n&, k%, j&, i&, s&
   
5. Range("a3:h65536").ClearContents
   
6. n = 3
   
7. For k = 1 To 2
   
8.     arr = Sheets(k).UsedRange
   
9.     For i = 2 To UBound(arr)
   
10.         If InStr(arr(i, 1), "对应单号") And Len(arr(i, 1)) > 5 Then
    
11.             brr = Sheets(k).Cells(i, 1).Resize(16, 8)
    
12.             y = Val(brr(1, 6)): m = Val(brr(1, 7)): r = Val(brr(1, 8))
    
13.             rq = DateSerial(y, m, r)
    
14.             dh = Mid(brr(1, 1), 6)
    
15.             mc = Mid(brr(2, 1), 4)
    
16.             s = 0
    
17.             For j = 4 To UBound(brr)
    
18.                 If brr(j, 2) <> "" Then
    
19.                     s = s + 1
    
20.                     crr(s, 1) = rq
    
21.                     crr(s, 2) = dh
    
22.                     crr(s, 3) = mc
    
23.                     crr(s, 4) = brr(j, 2)
    
24.                     crr(s, 5) = brr(j, 5)
    
25.                     crr(s, 6) = brr(j, 6)
    
26.                     crr(s, 7) = brr(j, 7)
    
27.                     crr(s, 8) = brr(j, 3)
    
28.                 End If
    
29.             Next
    
30.             Cells(n, 1).Resize(s, UBound(crr, 2)) = crr
    
31.             n = n + s
    
32.         End If
    
33.     Next
    
34. Next
    
35. x = Sheet3.Range("a65536").End(xlUp).Row
    
36. If x < 3 Then Exit Sub
    
37. Sheet3.Range("a3:h" & x).Copy Cells(n, 1)
    
38. End Sub
    

复制代码

增加纠错处理和判断

新一

dsmch 发表于 2014-3-21 18:49
增加纠错处理和判断

为何，王五表中我已经设置好打印预览后，保存好，再按一下个人明细按钮后，我先前所设置的打印预览格式不见了，又要重新设置了，可否帮助解决，谢谢