[已解决]vba数据行列转换（交叉）

jjl_sky

问题描述在附件中详细有说

忘各位大侠，赐教 ！感激不尽

L2SkcWJ1.rar (4.18 KB, 下载次数: 60)

2009-12-17 17:02 上传

点击文件名下载附件
vba数据行列转换（交叉）

最佳答案

月排行榜 / 总排行榜

雨狐

2009-12-17 18:36

T2JGgWwi.rar (13.18 KB, 下载次数: 181)

2009-12-17 18:36 上传

点击文件名下载附件
vba数据行列转换（交叉）

Sub a()
Dim arr, arrt
Dim i%, j%, K%
Dim Dic As New Dictionary
Dim Did As New Dictionary
Dim Die As New Dictionary
With Sheets("数据源")
    arr = .Range("a2:c" & .[a65536].End(xlUp).Row)
End With
For i = 1 To UBound(arr)
    Dic(arr(i, 1)) = ""
    Did(arr(i, 2)) = ""
    Die(arr(i, 1) & arr(i, 2)) = arr(i, 3)
Next
With Sheets("生成表")
    .Cells.ClearContents
    .[a1] = "姓名"
    .[b1].Resize(1, Did.Count).NumberFormatLocal = "yyyy-m-d h:mm;@"
    .[b1].Resize(1, Did.Count) = Did.Keys
    .[a2].Resize(Dic.Count, 1) = WorksheetFunction.Transpose(Dic.Keys)
    arrt = .[a1].Resize(Dic.Count + 1, Did.Count + 1)
    For K = 2 To UBound(arrt)
        For j = 2 To UBound(WorksheetFunction.Transpose(arrt))
            arrt(K, j) = Die(arrt(K, 1) & arrt(1, j))
        Next
    Next
    .[a1].Resize(Dic.Count + 1, Did.Count + 1) = arrt
    .Cells.EntireColumn.AutoFit
End With
Set Dic = Nothing
Set Did = Nothing
Set Die = Nothing
End Sub

跳转到最佳答案楼层

随风而去

Fj7kxfqZ.rar (10.24 KB, 下载次数: 27)

2009-12-17 17:28 上传

点击文件名下载附件
vba数据行列转换（交叉）

录制宏就行了吧.

零点★沉思

采用数据透视表就可以了 Ewb6WEJs.zip (7.08 KB, 下载次数: 33)

2009-12-17 17:37 上传

点击文件名下载附件
vba数据行列转换（交叉）

雨狐

T2JGgWwi.rar (13.18 KB, 下载次数: 181)

2009-12-17 18:36 上传

点击文件名下载附件
vba数据行列转换（交叉）

Sub a()
Dim arr, arrt
Dim i%, j%, K%
Dim Dic As New Dictionary
Dim Did As New Dictionary
Dim Die As New Dictionary
With Sheets("数据源")
    arr = .Range("a2:c" & .[a65536].End(xlUp).Row)
End With
For i = 1 To UBound(arr)
    Dic(arr(i, 1)) = ""
    Did(arr(i, 2)) = ""
    Die(arr(i, 1) & arr(i, 2)) = arr(i, 3)
Next
With Sheets("生成表")
    .Cells.ClearContents
    .[a1] = "姓名"
    .[b1].Resize(1, Did.Count).NumberFormatLocal = "yyyy-m-d h:mm;@"
    .[b1].Resize(1, Did.Count) = Did.Keys
    .[a2].Resize(Dic.Count, 1) = WorksheetFunction.Transpose(Dic.Keys)
    arrt = .[a1].Resize(Dic.Count + 1, Did.Count + 1)
    For K = 2 To UBound(arrt)
        For j = 2 To UBound(WorksheetFunction.Transpose(arrt))
            arrt(K, j) = Die(arrt(K, 1) & arrt(1, j))
        Next
    Next
    .[a1].Resize(Dic.Count + 1, Did.Count + 1) = arrt
    .Cells.EntireColumn.AutoFit
End With
Set Dic = Nothing
Set Did = Nothing
Set Die = Nothing
End Sub

jjl_sky

谢谢   我来试一试   嘿嘿

zsd5237

学习[em02][em02]