Excel VBA反向转置

时间:2016-05-17 01:46:57

标签: excel vba excel-vba

我试图基本上用一行数据交换列,但只是该行的某个选择。我有一张看起来像这样的表:

Month    Year Group Min Max
January  2014  A    10 50
January  2014  B    5  75
January  2014  C    25 40
February 2014  A    5  20
February 2014  B    4  8
February 2014  C    22 68

我想创建一个新的字段,将Min和Max折叠成一个名为Meausure的新列。然后将组转移到值上,以便最终结果为:

Month    Year Measure  A   B  C
January  2014 Min      10  5  25
January  2014 Max      50  75 40
February 2014 Min      5   4  22
February 2014 Max      20  8  68

我发现很难确切地解释操作的顺序是什么,所以希望这些表能够提供足够的洞察力。我找到了其他一些" unpivot"宏,但似乎没有任何东西适用于这种类型的数据结构。

1 个答案:

答案 0 :(得分:0)

考虑运行SQL,因为您的需求只是用于透视的条件聚合查询的并集。不需要复杂的循环,数组对象等。假设您使用PC / Excel,使用Jet / ACE SQL引擎(Windows .dll文件),Excel可以在工作簿上运行SQL查询。下面在名为[MAIN]的工作表中保存源数据,并在名为[RESULTS]的工作表中输出查询:

Sub RunSQL()
On Error GoTo ErrHandle
    Dim conn As Object, rst As Object
    Dim strConnection As String, strSQL As String
    Dim i As Integer, fld As Object

    Set conn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.Recordset")

    ' DB CONNECTION STRING (TWO TYPES SHOWN HERE)'
'    strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
'                      & "DBQ=C:\Path\To\Workbook.xlsx;"
    strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                       & "Data Source='C:\Path\To\Workbook.xlsx';" _
                       & "Extended Properties=""Excel 8.0;HDR=YES;"";"

    ' SQL STATEMENT '
    strSQL = "SELECT [MAIN$].[Month], [MAIN$].[Year], 'Min' As Type, "
    strSQL = strSQL & " SUM(IIF(Group = 'A', Min, NULL)) AS [A],"
    strSQL = strSQL & " SUM(IIF(Group = 'B', Min, NULL)) AS [B],"
    strSQL = strSQL & " SUM(IIF(Group = 'C', Min, NULL)) AS [C]"
    strSQL = strSQL & " FROM [MAIN$]"
    strSQL = strSQL & " GROUP BY [MAIN$].[Month], [MAIN$].[Year]"
    strSQL = strSQL & " "
    strSQL = strSQL & " UNION"
    strSQL = strSQL & " "
    strSQL = strSQL & " SELECT [MAIN$].[Month], [MAIN$].[Year], 'Max' As Type,"
    strSQL = strSQL & "        SUM(IIF(Group = 'A', Max, NULL)) AS [A],"
    strSQL = strSQL & "        SUM(IIF(Group = 'B', Max, NULL)) AS [B],"
    strSQL = strSQL & "        SUM(IIF(Group = 'C', Max, NULL)) AS [C]"
    strSQL = strSQL & " FROM [MAIN$]"
    strSQL = strSQL & " GROUP BY [MAIN$].[Month], [MAIN$].[Year]"

    ' OPEN DB AND RECORDSET '
    conn.Open strConnection
    rst.Open strSQL, conn

    ' COLUMN HEADERS '
    i = 0
    Worksheets("RESULTS").Range("A1").Activate
    For Each fld In rst.Fields
        ActiveCell.Offset(0, i) = fld.Name
        i = i + 1
    Next fld

    ' DATA ROWS '
    Worksheets("RESULTS").Range("A2").CopyFromRecordset rst

    ' CLOSE DB AND RECORDSET '
    rst.Close
    conn.Close

    MsgBox "Successfully ran SQL query!", vbInformation
    Exit Sub

ErrHandle:
    MsgBox Err.Number & " = " & Err.Description, vbCritical
    Exit Sub
End Sub

输出

(如聚合顺序分组,按整数/双数字顺序分组,字母顺序为字符串值,因此在1月之前的2月和最小之前的最大值 - 根据需要调整源数据)

' Month     Year    Type    A   B   C
' February  2014    Max     20  8   68
' February  2014    Min     5   4   22
' January   2014    Max     50  75  40
' January   2014    Min     10  5   25

迭代多列,在SQL查询周围使用For Each循环,甚至考虑Jet / ACE SQL的唯一Crosstab query

Sub RunAutoSQL()
    Dim conn As Object, rst As Object
    Dim strConnection As String, strSQL As String
    Dim i As Integer, fld As Object
    Dim item As Variant
    Dim lastrow As Long

    Set conn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.Recordset")

    ' DB CONNECTION STRING
    strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                       & "Data Source='C:\Path\To\Workbook.xlsx';" _
                       & "Extended Properties=""Excel 8.0;HDR=YES;"";"

    ' OPEN CONNECTION '
    conn.Open strConnection

    ' LIST ALL NEEDED COLUMNS '
    For Each item In Array("Min", "Max")

        ' SQL STATEMENT
        strSQL = "TRANSFORM Sum([MAIN$]." & item & ") As SumOfMax"
        strSQL = strSQL & " SELECT [MAIN$].[Month], [MAIN$].[Year],'" & item & "' As Type"
        strSQL = strSQL & " FROM [MAIN$]"
        strSQL = strSQL & " GROUP BY [MAIN$].[Month], [MAIN$].[Year]"
        strSQL = strSQL & " PIVOT [MAIN$].Group IN ('A', 'B', 'C')"

        ' OPEN RECORDSET
        rst.Open strSQL, conn

        ' COLUMN HEADERS
        If item = "Min" Then
            i = 0
            Worksheets("RESULTS").Range("A1").Activate
            For Each fld In rst.Fields
                ActiveCell.Offset(0, i) = fld.Name
                i = i + 1
            Next fld
        End If

        ' DATA ROWS
        lastrow = Worksheets("RESULTS").Cells(Worksheets("RESULTS").Rows.Count, _  
                                              "A").End(xlUp).Row
        Worksheets("RESULTS").Range("A" & lastrow + 1).CopyFromRecordset rst

        ' CLOSE RECORDSET '
        rst.Close

    Next item

  ' CLOSE CONNECTION '
  conn.Close 
End Sub