[已解决]如何保留原格式?

zhouxingyu

请哪位朋友帮忙修改下代码,使之能够保留原有的数据格式.说明和代码详见附件,多谢了!
分组转置合并.rar (13.32 KB, 下载次数: 6)

2013-2-12 17:40 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

cbg2008

2013-2-12 18:06

1. Sub t()
   
2.     Dim i&, j%, k%, ar, br()
   
3.     ar = Sheet1.Range("a1", Sheet1.[d65536].End(3))
   
4.     ReDim br(1 To 11, 1 To (UBound(ar) + 1) / 10)
   
5.     For i = 1 To (UBound(ar) + 1) Step 10
   
6.         k = k + 1
   
7.         br(1, k) = ar(i, 1)
   
8.         br(2, k) = ar(i, 2)
   
9.         For j = 3 To 11
   
10.             br(j, k) = ar(i + j - 3, 4)
    
11.         Next
    
12.     Next
    
13.     With Sheet2
    
14.         .Cells.ClearContents
    
15.         .[a1].Resize(11, k) = br
    
16.         With .Range("A1:D1").Font
    
17.             .Color = -16776961
    
18.             .Bold = True
    
19.         End With
    
20.         With .Range("A2:D2")
    
21.             .NumberFormatLocal = "yy-m-d"
    
22.             .Font.Bold = True
    
23.         End With
    
24.         With .Range("A3:D11")
    
25.             .HorizontalAlignment = xlCenter
    
26.             .Font.Bold = True
    
27.         End With
    
28.     End With
    
29. End Sub

复制代码

跳转到最佳答案楼层

cbg2008

1. Sub t()
   
2.     Dim i&, j%, k%, ar, br()
   
3.     ar = Sheet1.Range("a1", Sheet1.[d65536].End(3))
   
4.     ReDim br(1 To 11, 1 To (UBound(ar) + 1) / 10)
   
5.     For i = 1 To (UBound(ar) + 1) Step 10
   
6.         k = k + 1
   
7.         br(1, k) = ar(i, 1)
   
8.         br(2, k) = ar(i, 2)
   
9.         For j = 3 To 11
   
10.             br(j, k) = ar(i + j - 3, 4)
    
11.         Next
    
12.     Next
    
13.     With Sheet2
    
14.         .Cells.ClearContents
    
15.         .[a1].Resize(11, k) = br
    
16.         With .Range("A1:D1").Font
    
17.             .Color = -16776961
    
18.             .Bold = True
    
19.         End With
    
20.         With .Range("A2:D2")
    
21.             .NumberFormatLocal = "yy-m-d"
    
22.             .Font.Bold = True
    
23.         End With
    
24.         With .Range("A3:D11")
    
25.             .HorizontalAlignment = xlCenter
    
26.             .Font.Bold = True
    
27.         End With
    
28.     End With
    
29. End Sub

复制代码

zhouxingyu

cbg2008 发表于 2013-2-12 18:06

有劳你了朋友.不过这并不是我想要的结果.
你是把格式再重新设置了一遍是吧?
组的数量是不固定的,如果数量增减那样会很麻烦.
谢谢你的答复!

cbg2008

数组赋值到单元格是不能保留单元格格式的，只能是重新设置，或者复制格式，所以只能判断赋值到单元格的区域大小，再重新设置格式，如果用引用函数，那是可以带格式引用的。

zhouxingyu

cbg2008 发表于 2013-2-12 18:19
数组赋值到单元格是不能保留单元格格式的，只能是重新设置，或者复制格式，所以只能判断赋值到单元格的区域 ...

也就是说只能在sheet2中设置好格式,不能把sheet1中连格式一起转置复制过来?

cbg2008

不能，用数组决定了不能连格式带值复制到sheet2

zhouxingyu

cbg2008 发表于 2013-2-12 18:23
不能，用数组决定了不能连格式带值复制到sheet2

明白了,我去想个变通办法吧.
非常感谢你的解答!