VBA 一维转二维 ( 有点小难 )

On_fire

VBA 一维转二维 ( 有点小难 )

*

Sheet1是源资料, 暂时删掉不参加处理的数据

Range (“AA:AF”)是要处理的数据, 行数是变量

*

代码逻辑如下,

1.      AA列转成标题行, AB列转成标题列

2.      分别取同行的AD及AF两列的对应值到矩阵

*

部分模拟结果在Sheet1(2)

*

恳请大神, 老师出手帮忙…谢谢!

笨鸟飞不高

1to2.zip (23.47 KB, 下载次数: 31)

2023-2-18 14:44 上传

点击文件名下载附件

gwjkkkkk

Option Explicit
Sub TEST()
    Dim ar, vResult, i&, j&, y&, x&, dic As Object, vKey
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 0 To 1
        Set dic(i) = CreateObject("Scripting.Dictionary")
    Next i
   
    ar = Range("AA2", Cells(Rows.Count, "AF").End(3))
    For i = 1 To UBound(ar): dic(0)(ar(i, 1)) = "": Next
    For i = 1 To UBound(ar)
        vKey = ar(i, 2) & "|" & ar(i, 1)
        dic(1)(vKey) = Array(ar(i, 4), ar(i, 6))
    Next i
   
    ReDim vResult(1 To dic(0).Count + 1, 1 To dic(0).Count * 2 + 1)
    y = 1
    For Each vKey In dic(0).keys
        y = y + 1
        vResult(y, 1) = vKey
        x = x + 1
        vResult(1, x * 2) = vKey
    Next
    For i = 2 To UBound(vResult)
        For j = 2 To UBound(vResult, 2) Step 2
            vKey = vResult(i, 1) & "|" & vResult(1, j)
                If dic(1).exists(vKey) Then
                vResult(i, j) = dic(1)(vKey)(0)
                vResult(i, j + 1) = dic(1)(vKey)(1)
            End If
        Next j
    Next i
   
   
    With [Al1].Resize(UBound(vResult), UBound(vResult, 2))
        .Value = vResult
        For i = 2 To UBound(vResult, 2) Step 2
            .Cells(1, i).Resize(, 2).Merge
        Next i
        .HorizontalAlignment = xlCenter
        .Borders.LineStyle = xlContinuous
        .Columns(1).Font.Bold = True
        .Rows(1).Font.Bold = True
        .EntireColumn.AutoFit
        .EntireRow.AutoFit
    End With
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

请楼主参考附件。。。

fzxba

1to2.rar (28.79 KB, 下载次数: 17)

2023-2-18 14:52 上传

点击文件名下载附件

tiandi123

用vlookup函数做的，你试试

幼稚园儿童

参与一下，楼主试试，ps：我刚才在干什么，把楼主原版文件传上来，晕

On_fire

笨鸟飞不高 发表于 2023-2-18 14:44

统一回复,
感谢大神们, 老师们的热心帮忙…
看似是神仙们在打架, 各显神通…厉害!

cjc209

数据透视 瞬间搞定 还要写代码?