使用Excel vba转换矩阵的重复范围

我有一个情况，我有多组矩阵，我想转置和 希望获得有关Excel vba代码的帮助。提前感谢您的帮助

我的表格如下所示-（它将是13个月视图，但我只显示了3个示例）

等等（更多的小组和更多的月份） 期望结果---

等等（它们的值被转换）

示例代码并不完全给出上述结果，而是我曾经使用过的东西

Sub transposedata()
Dim vcol1 As Variant, vcol2 As Variant, vcol3 As Variant, vcol4 As Variant, vcol5 As Variant, vcol6 As Variant
Dim lastrow As Long
Dim ws As Worksheet


Set ws = Sheets(1)

lastrow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

lastrow = lastrow - 1

vcol1 = WorksheetFunction.transpose(ws.Range("B2").Resize(lastrow).Value)
vcol2 = WorksheetFunction.transpose(ws.Range("C2").Resize(lastrow).Value)
vcol3 = WorksheetFunction.transpose(ws.Range("D2").Resize(lastrow).Value)
vcol4 = WorksheetFunction.transpose(ws.Range("E2").Resize(lastrow).Value)
vcol5 = WorksheetFunction.transpose(ws.Range("F2").Resize(lastrow).Value)
vcol6 = WorksheetFunction.transpose(ws.Range("G2").Resize(lastrow).Value)

ws.Range("J2").Resize(1, UBound(vcol1)) = vcol1
ws.Range("J3").Resize(1, UBound(vcol1)) = vcol2
ws.Range("J4").Resize(1, UBound(vcol1)) = vcol3
ws.Range("J5").Resize(1, UBound(vcol1)) = vcol4
ws.Range("J6").Resize(1, UBound(vcol1)) = vcol5
ws.Range("J7").Resize(1, UBound(vcol1)) = vcol6

End Sub

测试：

Sub Pivot()
    Const NUM_MONTHS As Long = 3
    Const NUM_PROPS As Long = 3

    Dim rng As Range, rngDest As Range, arrProps, x

    'first block of source data
    Set rng = Sheets("Sheet1").Range("A2").Resize(NUM_MONTHS, 5)

    'header labels
    arrProps = Application.Transpose(rng.Rows(1).Offset(-1, 0). _
                              Cells(3).Resize(1, NUM_PROPS).Value)

    'top-left of destination table
    Set rngDest = Sheets("Sheet1").Range("J1")

    'set up headers
    With rngDest
        .Value = "Group"
        .Offset(0, 1).Value = "property"
        .Offset(0, 2).Resize(1, NUM_MONTHS).Value = _
                Application.Transpose(rng.Columns(2).Value)
    End With
    Set rngDest = rngDest.Offset(1, 0)

    'copy data
    Do While rng.Cells(1).Value <> ""
        rngDest.Value = rng.Cells(1, 1).Value 'group
        'property names
        rngDest.Offset(0, 1).Resize(NUM_PROPS, 1).Value = arrProps

        'property values
        For x = 1 To NUM_PROPS
            rngDest.Offset(x - 1, 2).Resize(1, NUM_MONTHS).Value = _
                Application.Transpose(rng.Columns(2 + x).Value)
        Next x

        'move to next block
        Set rng = rng.Offset(NUM_MONTHS, 0)
        Set rngDest = rngDest.Offset(3, 0)
    Loop
End Sub

Sub-Pivot（）
Const NUM_月长=3
Const NUM_道具长度=3
变暗rng作为范围，rng作为范围，arrProps，x
'源数据的第一块
设置rng=图纸（“图纸1”）。范围（“A2”）。调整大小（月数，5）
'标题标签
arrProps=Application.Transpose（rng.Rows（1）.Offset（-1,0）_
单元格（3）.调整大小（1，NUM_PROPS）.Value）
'目标表的左上角
设置rngDest=板材（“板材1”）。范围（“J1”）
'设置标题
使用rngDest
.Value=“组”
.Offset（0，1）.Value=“属性”
.偏移量（0，2）。调整大小（1，个月）。值=_
Application.Transpose（rng.Columns（2）.Value）
以
设置rngDest=rngDest.Offset（1,0）
'复制数据
Do While rng.Cells（1）.值“”
rngDest.Value=rng.Cells（1,1.Value）组
"物业名称
rngDest.Offset（0，1）。调整大小（NUM_PROPS，1）。Value=arrProps
'属性值
对于x=1到NUM_道具
rngDest.Offset（x-1，2）。调整大小（1，NUM\u个月）。值=_
Application.Transpose（rng.Columns（2+x）.Value）
下一个x
“移动到下一个街区
设置rng=rng.偏移量（个月，0）
设置rngDest=rngDest.Offset（3,0）
环
端接头

结果中的“T”来自何处？您好，Tim，原始数据中缺少T，2月份的形状栏下应该有T。希望对您有所帮助。如果您还有其他问题，请告诉我。谢谢你的帮助。你有没有代码可以共享（即使它不工作）？总是有助于证明你已经尝试了一些东西。你好，蒂姆，这是我正在使用的代码——它有点工作，但我正在寻找第一列，而不是循环，因此它产生的结果与我预期的不一样。我需要循环并检查第一列中的值。再次感谢你的帮助。这是代码组属性月1月2月组颜色B G形状S T成本1 2 A Y W M R C S 3 5 4 B P R 7您好，谢谢您的帮助。我运行了代码，它转换了A组和B组的1月和2月数据。我不知道为什么3月数据会移动到下一个区块。我不确定我是否错过了什么。再次感谢您的帮助。蒂姆，我知道我错过了什么，我把数据移到了第1行A1开始。非常感谢你的帮助。代码工作得很好。我感谢你的帮助。

Sub transposedata()
Dim vcol1 As Variant, vcol2 As Variant, vcol3 As Variant, vcol4 As Variant, vcol5 As Variant, vcol6 As Variant
Dim lastrow As Long
Dim ws As Worksheet


Set ws = Sheets(1)

lastrow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

lastrow = lastrow - 1

vcol1 = WorksheetFunction.transpose(ws.Range("B2").Resize(lastrow).Value)
vcol2 = WorksheetFunction.transpose(ws.Range("C2").Resize(lastrow).Value)
vcol3 = WorksheetFunction.transpose(ws.Range("D2").Resize(lastrow).Value)
vcol4 = WorksheetFunction.transpose(ws.Range("E2").Resize(lastrow).Value)
vcol5 = WorksheetFunction.transpose(ws.Range("F2").Resize(lastrow).Value)
vcol6 = WorksheetFunction.transpose(ws.Range("G2").Resize(lastrow).Value)

ws.Range("J2").Resize(1, UBound(vcol1)) = vcol1
ws.Range("J3").Resize(1, UBound(vcol1)) = vcol2
ws.Range("J4").Resize(1, UBound(vcol1)) = vcol3
ws.Range("J5").Resize(1, UBound(vcol1)) = vcol4
ws.Range("J6").Resize(1, UBound(vcol1)) = vcol5
ws.Range("J7").Resize(1, UBound(vcol1)) = vcol6

End Sub

Sub Pivot()
    Const NUM_MONTHS As Long = 3
    Const NUM_PROPS As Long = 3

    Dim rng As Range, rngDest As Range, arrProps, x

    'first block of source data
    Set rng = Sheets("Sheet1").Range("A2").Resize(NUM_MONTHS, 5)

    'header labels
    arrProps = Application.Transpose(rng.Rows(1).Offset(-1, 0). _
                              Cells(3).Resize(1, NUM_PROPS).Value)

    'top-left of destination table
    Set rngDest = Sheets("Sheet1").Range("J1")

    'set up headers
    With rngDest
        .Value = "Group"
        .Offset(0, 1).Value = "property"
        .Offset(0, 2).Resize(1, NUM_MONTHS).Value = _
                Application.Transpose(rng.Columns(2).Value)
    End With
    Set rngDest = rngDest.Offset(1, 0)

    'copy data
    Do While rng.Cells(1).Value <> ""
        rngDest.Value = rng.Cells(1, 1).Value 'group
        'property names
        rngDest.Offset(0, 1).Resize(NUM_PROPS, 1).Value = arrProps

        'property values
        For x = 1 To NUM_PROPS
            rngDest.Offset(x - 1, 2).Resize(1, NUM_MONTHS).Value = _
                Application.Transpose(rng.Columns(2 + x).Value)
        Next x

        'move to next block
        Set rng = rng.Offset(NUM_MONTHS, 0)
        Set rngDest = rngDest.Offset(3, 0)
    Loop
End Sub