[已解决]用VBA进行指定行的单元格合并

zyryc

要求在“原数据”工作表中。
谢谢！

问题2013.rar (5.83 KB, 下载次数: 31)

2013-2-22 09:26 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

那么的帅

2013-2-22 10:12

1. Sub 合并数据()
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Sheets("原数据").Columns("A:I").Copy
   
5.     With Sheets("结果")
   
6.         .Cells.Clear
   
7.         Sheets("原数据").Columns("A:I").Copy
   
8.         .Columns("A:A").Insert Shift:=xlToRight
   
9.         Application.CutCopyMode = False
   
10.         For I = 1 To .Range("I65536").End(xlUp).Row
    
11.             Select Case .Range("I" & I)
    
12.             Case "标题"
    
13.                 .Range(.Cells(I, 1), .Cells(I, 7)).Merge
    
14.                 .Range(.Cells(I, 1), .Cells(I, 7)).HorizontalAlignment = xlCenter
    
15.             Case 2
    
16.                 .Range(.Cells(I, 1), .Cells(I, 7)).Merge
    
17.                 .Range(.Cells(I, 1), .Cells(I, 7)).HorizontalAlignment = xlLeft
    
18.             Case 1
    
19.                 .Range(.Cells(I, 1), .Cells(I, 2)).Merge
    
20.                 .Range(.Cells(I, 1), .Cells(I, 2)).HorizontalAlignment = xlLeft
    
21.                 .Range(.Cells(I, 3), .Cells(I, 4)).Merge
    
22.                 .Range(.Cells(I, 3), .Cells(I, 4)).HorizontalAlignment = xlLeft
    
23.                 .Range(.Cells(I, 5), .Cells(I, 7)).Merge
    
24.                 .Range(.Cells(I, 5), .Cells(I, 7)).HorizontalAlignment = xlLeft
    
25.             End Select
    
26.         Next I
    
27.         .Columns("H:I").Clear
    
28.         .Rows("1:1").Delete
    
29.         Sheets("样表").Columns("A:G").Copy
    
30.         .Columns("A:G").PasteSpecial Paste:=xlPasteColumnWidths
    
31.         Application.CutCopyMode = False
    
32.         .Rows("1:" & .Range("A65536").End(xlUp).Row).RowHeight = 18
    
33.     End With
    
34.     Application.ScreenUpdating = True
    
35.     Application.DisplayAlerts = True
    
36. End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy

range.merge就是合并。

那么的帅

1. Sub 合并数据()
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Sheets("原数据").Columns("A:I").Copy
   
5.     With Sheets("结果")
   
6.         .Cells.Clear
   
7.         Sheets("原数据").Columns("A:I").Copy
   
8.         .Columns("A:A").Insert Shift:=xlToRight
   
9.         Application.CutCopyMode = False
   
10.         For I = 1 To .Range("I65536").End(xlUp).Row
    
11.             Select Case .Range("I" & I)
    
12.             Case "标题"
    
13.                 .Range(.Cells(I, 1), .Cells(I, 7)).Merge
    
14.                 .Range(.Cells(I, 1), .Cells(I, 7)).HorizontalAlignment = xlCenter
    
15.             Case 2
    
16.                 .Range(.Cells(I, 1), .Cells(I, 7)).Merge
    
17.                 .Range(.Cells(I, 1), .Cells(I, 7)).HorizontalAlignment = xlLeft
    
18.             Case 1
    
19.                 .Range(.Cells(I, 1), .Cells(I, 2)).Merge
    
20.                 .Range(.Cells(I, 1), .Cells(I, 2)).HorizontalAlignment = xlLeft
    
21.                 .Range(.Cells(I, 3), .Cells(I, 4)).Merge
    
22.                 .Range(.Cells(I, 3), .Cells(I, 4)).HorizontalAlignment = xlLeft
    
23.                 .Range(.Cells(I, 5), .Cells(I, 7)).Merge
    
24.                 .Range(.Cells(I, 5), .Cells(I, 7)).HorizontalAlignment = xlLeft
    
25.             End Select
    
26.         Next I
    
27.         .Columns("H:I").Clear
    
28.         .Rows("1:1").Delete
    
29.         Sheets("样表").Columns("A:G").Copy
    
30.         .Columns("A:G").PasteSpecial Paste:=xlPasteColumnWidths
    
31.         Application.CutCopyMode = False
    
32.         .Rows("1:" & .Range("A65536").End(xlUp).Row).RowHeight = 18
    
33.     End With
    
34.     Application.ScreenUpdating = True
    
35.     Application.DisplayAlerts = True
    
36. End Sub

复制代码

guogongyi

不明白解决了什么总是？

guogongyi

不明白解决了什么问题？