根据标准选择单元格，然后重新定位特殊（转置）

Question

我想知道是否有人可以帮我解决以下问题。我在这样的表格中有一个矩阵：

  __   1w  |  2w  |  ..  |  25w

  a | 5,6  |  4,5 |  ..  |  12

  b | 2,4  | 11,2 |  ..  |  34,45

  : | :::  |  ::: |  ::  |  ::

  z | 3,3  |  1,5 |  ..  |  24,91

我想以特殊方式转置行和列，以便它们在新工作表上保持如下：

       1w  |   a  |  5,6
       2w  |   a  |  4,5   
       ..  |   .  |  ...
       25w |   a  |  12
       1w  |   b  |  2,4
       2w  |   b  |  11,2
       ..  |   .  |  ...
       25w |   b  |  34,45
       ..  |   .  |  ...
       ..  |   .  |  ...
       1w  |   z  |  3,3
       2w  |   z  |  1,5
       ..  |   .  |  ...
       25w |   z  |  24,91

我可以手工完成，但这需要很长时间，因为我有很多数据。反正有自动化吗？

Answer 1

可以使用嵌套循环甚至SQL交叉连接来完成矩阵的展平。

Sub flipShow()
    Dim a As Long, b As Long, vTMPs As Variant, vVALs As Variant

    With Worksheets("Sheet1")
        With .Cells(1, 1).CurrentRegion
            vTMPs = .Value2
            ReDim vVALs(1 To (UBound(vTMPs, 1) - 1) * (UBound(vTMPs, 2) - 1), 1 To 3)
        End With
    End With

    For a = LBound(vTMPs, 1) + 1 To UBound(vTMPs, 1)
        For b = LBound(vTMPs, 2) + 1 To UBound(vTMPs, 2)
            Debug.Print (b - 1) + ((a - 2) * UBound(vTMPs, 2))
            vVALs((b - 1) + ((a - 2) * (UBound(vTMPs, 2) - 1)), 1) = vTMPs(1, b)
            vVALs((b - 1) + ((a - 2) * (UBound(vTMPs, 2) - 1)), 2) = vTMPs(a, 1)
            vVALs((b - 1) + ((a - 2) * (UBound(vTMPs, 2) - 1)), 3) = vTMPs(a, b)
        Next b
    Next a

    With Worksheets("Sheet2")
        .Cells.Clear
        .Cells(1, 1).Resize(UBound(vVALs, 1), UBound(vVALs, 2)) = vVALs
    End With

End Sub

<强> Sample results