[已解决]数据竖排转成横排

张雄友

数据竖排转成横排。

最佳答案

月排行榜 / 总排行榜

qh8600

2014-12-29 21:43

张雄友 发表于 2014-12-29 20:51
再请教一个排序问题。

(, 下载次数: 12)

上传

点击文件名下载附件
这样

跳转到最佳答案楼层

qh8600

老张附件中少了个2012-1-3，我已加上

1. Sub demo()
   
2.     Dim ar, re, br(), d, i, m, j, x, n
   
3.     ar = Range("a2:d" & Cells(Rows.Count, 1).End(3).Row)
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     re = Range("g3:am3")
   
6.     For i = 1 To UBound(ar)
   
7.         d(ar(i, 2)) = ""
   
8.     Next
   
9.     m = d.Keys
   
10.     ReDim br(1 To d.Count, 1 To UBound(re, 2))
    
11.     For x = 1 To d.Count
    
12.         n = n + 1
    
13.         For i = 1 To UBound(ar)
    
14.             If ar(i, 2) = m(x - 1) Then
    
15.                 br(n, 1) = ar(i, 1)
    
16.                 br(n, 2) = ar(i, 2)
    
17.                 For j = 3 To UBound(br, 2)
    
18.                     If ar(i, 3) = re(1, j) Then
    
19.                         br(n, j) = "'" & ar(i, 4)
    
20.                     End If
    
21.                 Next
    
22.             End If
    
23.         Next
    
24.     Next
    
25.     Range("g4").Resize(UBound(br), UBound(br, 2)).ClearContents
    
26.     Range("g4").Resize(UBound(br), UBound(br, 2)) = br
    
27. End Sub

复制代码

附件楼下

qh8600

数据竖排转成横排.rar (16.56 KB, 下载次数: 16)

2014-12-29 19:19 上传

点击文件名下载附件

楼主试试

张雄友

qh8600 发表于 2014-12-29 18:59
楼主试试

附件不是我要的，您发错了。

qh8600

张雄友 发表于 2014-12-29 19:16
附件不是我要的，您发错了。

发错了，我重新编辑一下哈{:112:}

张雄友

qh8600 发表于 2014-12-29 18:59
楼主试试

附件中就是没有：2012-1-3的。如果有就会使人产生误解一个月每天都有。标题不是自动生成的？怎么知道是哪一天的？

张雄友

qh8600 发表于 2014-12-29 19:18
发错了，我重新编辑一下哈

黄色单元格就是刷卡日期要自动生成，红色单元格没有就不要显示啊，老大。

qh8600

张雄友 发表于 2014-12-29 19:20
附件中就是没有：2012-1-3的。如果有就会使人产生误解一个月每天都有。标题不是自动生成的？怎么知道是哪 ...

明白了，我试试啊

qh8600

张雄友 发表于 2014-12-29 19:25
黄色单元格就是刷卡日期要自动生成，红色单元格没有就不要显示啊，老大。

数据竖排转成横排.rar (20.46 KB, 下载次数: 10)

2014-12-29 19:56 上传

点击文件名下载附件
老张这样试试哈

张雄友

qh8600 发表于 2014-12-29 19:57
老张这样试试哈

再请教一个排序问题。