求助：使用VBA语言将报表格式转换

renjk2004

正常录入的报表格式为14列4行的输入模式，需要转变为23列1行，之前用函数转换后运行非常慢，请各位大神帮忙解决，谢谢！

renjk2004

哪位高手帮忙解决下，谢谢！

loryli

我也只会比较笨的方法，共同学习吧

1. Sub 生成报表()
   
2. Dim i As Integer
   
3. Dim j As Integer
   
4. Dim n As Integer
   
5. Dim arr
   
6. Dim x As Integer
   
7. Dim m As Integer
   
8. Application.ScreenUpdating = False
   
9. Worksheets("原始表").Activate
   
10. x = Worksheets("原始表").[a65536].End(xlUp).Row
    
11. m = (x + 2) / 4
    
12. ReDim arr(1 To m, 1 To 23)
    
13. n = 0
    
14. For i = 2 To x Step 4
    
15. n = n + 1
    
16. arr(n, 1) = n
    
17. For j = 2 To 5
    
18. arr(n, j) = Cells(i, j - 1)
    
19. Next j
    
20. arr(n, 6) = Cells(i + 1, 3)
    
21. arr(n, 7) = Cells(i, 5)
    
22. arr(n, 8) = Cells(i, 6)
    
23. arr(n, 9) = Cells(i, 10)
    
24. arr(n, 10) = Cells(i + 1, 10)
    
25. arr(n, 11) = Cells(i + 2, 10)
    
26. arr(n, 12) = Cells(i + 3, 10)
    
27. arr(n, 13) = Cells(i, 11)
    
28. arr(n, 14) = Cells(i + 1, 11)
    
29. arr(n, 15) = Cells(i + 2, 11)
    
30. arr(n, 16) = Cells(i + 3, 11)
    
31. arr(n, 17) = Cells(i, 13)
    
32. arr(n, 18) = Cells(i, 12)
    
33. arr(n, 19) = Cells(i + 1, 6)
    
34. arr(n, 22) = Cells(i + 1, 5)
    
35. arr(n, 23) = Cells(i, 14)
    
36. Next i
    
37. 
    
38. Worksheets("报表").Range("a2:aa5000").ClearContents
    
39. Worksheets("报表").Range("a2").Resize(m, 23) = arr
    
40. Worksheets("报表").Activate
    
41. Range("T2").Select
    
42.     ActiveCell.FormulaR1C1 = _
    
43.         "=IF(R[1]C4=0,MAX(RC9:R[1]C12)-MIN(RC9:R[1]C12),MAX(RC9:RC12)-MIN(RC9:RC12))"
    
44.    Range("u2").Select
    
45.    ActiveCell.Formula = "=if(b2 = """","""",month(b2))"
    
46. 
    
47.    Range("T2:U" & m + 1).Select
    
48.    
    
49.     Selection.FillDown
    
50.     Application.ScreenUpdating = True
    
51. 
    
52. End Sub

复制代码

renjk2004

loryli 发表于 2018-4-13 10:28
我也只会比较笨的方法，共同学习吧

我试了下，非常好用，我在试下多数据的

loryli

学会n=n+1 这种转换方法，很多格式转换的问题都能解决，虽然方法还是有些笨拙~这一点只能靠以后慢慢学习积累了。