请教批量转置的宏写法

therock306

大佬们，想做个宏将图1的数据批量转置到图2.


例如图1的行1有5个表头，转置到图2后，将5个表头前面的中文标题都填充为行1中文标题的“寒假社会实践”

因为图1每一行“中文标题”对因的表头数量不固定，想问下大佬们这种情况如何做批量宏？
模板的副本.zip (13.32 KB, 下载次数: 5)

2024-3-12 23:20 上传

点击文件名下载附件

蓝桥玄霜

转置的例子：

sxbjzjf110

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim ar, br, i&, j&, r&
   
    Application.ScreenUpdating = False
   
    With Sheets(1)
        ar = Range(.[B1], .Cells(Rows.Count, "B").End(xlUp)).Resize(, 13).Value
        ReDim br(1 To UBound(ar) * UBound(ar), 1)
    End With
    Range("B2", Cells(Rows.Count, "C")).Clear
    For i = 2 To UBound(ar)
        For j = 2 To UBound(ar, 2)
            If Len(ar(i, j)) Then
                r = r + 1
                br(r, 0) = ar(i, 1)
                br(r, 1) = ar(i, j)
            End If
        Next j
    Next i
        
    [B2].Resize(r, 2) = br
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

请参考附件。。。