[已解决]求助：合并单元格、复制、转置的混合循环使用的程序设计

barden

本人新人。对VBA才了解一周。但是由于工作的需要，有大量的资料需要转换整理，发现效率很低。故求助于VBA，无奈学习时间短，自己无法设计出本人认为很复杂的程序。附件是一个工作薄，里面有表一和表二。现在期望各位大侠、高手帮忙设计一个程序。让表一转换为表二的表格。 加工工时.rar (9.8 KB, 下载次数: 10)

2011-4-4 13:24 上传

点击文件名下载附件
实例

最佳答案

月排行榜 / 总排行榜

sunjing-zxl

2011-4-4 21:53

回复 barden 的帖子

加工工时.rar (11.79 KB, 下载次数: 29)

2011-4-4 21:53 上传

点击文件名下载附件

1. Sub 表二()
   
2. Dim m, n, i, k, Co As Long
   
3. n = 1
   
4. i = 2
   
5. k = 2
   
6. Co = 1
   
7. 1:
   
8. For Co = 1 To 4
   
9. Sheets("表二").Cells(i, Co) = Sheets("表一").Cells(k, Co)
   
10. Next
    
11. m = Sheets("表一").Cells(k, 100).End(xlToLeft).Column - 4
    
12. Sheets("表二").Range("A" & i & ":A" & i + m - 1).MergeCells = True
    
13. Sheets("表二").Range("b" & i & ":b" & i + m - 1).MergeCells = True
    
14. Sheets("表二").Range("c" & i & ":c" & i + m - 1).MergeCells = True
    
15. Sheets("表二").Range("d" & i & ":d" & i + m - 1).MergeCells = True
    
16. For n = 1 To m
    
17. Sheets("表二").Cells(i + n - 1, 5) = n
    
18.     For Co = 6 To 8
    
19.     Sheets("表二").Cells(i + n - 1, Co) = Sheets("表一").Cells(k + Co - 6, 5 + n - 1)
    
20.     Next Co
    
21. Co = 6
    
22. Next n
    
23. i = i + m
    
24. k = k + 3
    
25. Co = 1
    
26. If k <= Sheets("表一").[A65536].End(xlUp).Row Then
    
27. GoTo 1
    
28. End If
    
29. Range("A2").Resize(i - 2, 8).Select
    
30. With Selection
    
31.      .Borders.LineStyle = 1
    
32.      .HorizontalAlignment = xlCenter
    
33.      .VerticalAlignment = xlCenter
    
34. End With
    
35. End Sub
    

复制代码

跳转到最佳答案楼层

sunjing-zxl

回复 barden 的帖子

加工工时.rar (11.79 KB, 下载次数: 29)

2011-4-4 21:53 上传

点击文件名下载附件

1. Sub 表二()
   
2. Dim m, n, i, k, Co As Long
   
3. n = 1
   
4. i = 2
   
5. k = 2
   
6. Co = 1
   
7. 1:
   
8. For Co = 1 To 4
   
9. Sheets("表二").Cells(i, Co) = Sheets("表一").Cells(k, Co)
   
10. Next
    
11. m = Sheets("表一").Cells(k, 100).End(xlToLeft).Column - 4
    
12. Sheets("表二").Range("A" & i & ":A" & i + m - 1).MergeCells = True
    
13. Sheets("表二").Range("b" & i & ":b" & i + m - 1).MergeCells = True
    
14. Sheets("表二").Range("c" & i & ":c" & i + m - 1).MergeCells = True
    
15. Sheets("表二").Range("d" & i & ":d" & i + m - 1).MergeCells = True
    
16. For n = 1 To m
    
17. Sheets("表二").Cells(i + n - 1, 5) = n
    
18.     For Co = 6 To 8
    
19.     Sheets("表二").Cells(i + n - 1, Co) = Sheets("表一").Cells(k + Co - 6, 5 + n - 1)
    
20.     Next Co
    
21. Co = 6
    
22. Next n
    
23. i = i + m
    
24. k = k + 3
    
25. Co = 1
    
26. If k <= Sheets("表一").[A65536].End(xlUp).Row Then
    
27. GoTo 1
    
28. End If
    
29. Range("A2").Resize(i - 2, 8).Select
    
30. With Selection
    
31.      .Borders.LineStyle = 1
    
32.      .HorizontalAlignment = xlCenter
    
33.      .VerticalAlignment = xlCenter
    
34. End With
    
35. End Sub
    

复制代码

barden

非常感谢sunjing-zxl ！你的程序非常的好!愿你每天过的开心！