如何像 Power Query 一样使用 VBA 旋转固定数量的列 [英] How to unpivot a Fixed number of columns with VBA just like Power Query

问题描述

例如，我有 130 列，其中 13 列必须是 Unpivoted.

I have 130 columns for example, and 13 of those columns have to be Unpivoted.

行数不时变化.

这适用于 Power Query.

This works with Power Query.

我附上了一个示例文件来展示我的数据是如何呈现的，

I attached a sample file to show how my data is being presented,

A 到 E 列是固定数组，F 以后的列将成为反透视的对象.

Columns A to E are the fixed array, and F onwards will be the columns subject for unpivoting.

我发现 PowerQuery 也支持 VBA.我在这里遇到错误:

I found out that PowerQuery also does VBA. I get an error here:

Sub Macro10()

    ActiveWorkbook.Queries.Add Name:="ProjectDetails (4)", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Excel.CurrentWorkbook(){[Name=""ProjectDetails""]}[Content]," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(Source,{{""Project"", Int64.Type}, {""Project2"", Int64.Type}, {""Project Name"", type text}, {""Strategic Business Unit"", type text}, {""Area"", type text}, {""Sub Area"", type text}, {""Business Line"", type text}, {""Department"", ty" & _
        "pe text}, {""AECOM Project Review Category"", type text}, {""Customer Name"", type text}, {""Customer Type"", type text}, {""Project Manager"", type text}, {""Project Accountant"", type text}, {""Project Biller"", type text}, {""Regional Director"", type text}, {""Project Director"", type text}, {""Project Status"", type text}, {""End-Client Sector"", type text}, {" & _
        """Global Business Line"", type text}, {""AECOM Work"", type text}, {""AECOM Funding Source"", type text}, {""Distribution Rule"", type text}, {""Agreement"", type text}, {""CRM Tracking #"", type text}, {""Last Invoiced Date"", type any}, {""Last EAC Date"", type any}, {""Scheduled Start Date"", type datetime}, {""Scheduled Finish Date"", type datetime}, {""Forecast" & _
        " End Date"", type datetime}, {""AECOM Contract Type"", type text}, {""MTD Revenue"", type number}, {""MTD Total Costs"", type number}, {""MTD DL"", type number}, {""MTD Fringe"", type number}, {""MTD Overhead"", type number}, {""MTD ODC"", type number}, {""MTD Subs"", type number}, {""NSR MTD"", type number}, {""MTD GM"", type number}, {""MTD GM % of Revenues"", typ" & _
        "e number}, {""MTD NM"", type number}, {""Direct Labor Multiplier MTD"", type number}, {""Salary Cost Multiplier MTD"", type number}, {""MTD Bookings"", type number}, {""YTD Revenue"", type number}, {""YTD Total Costs"", type number}, {""YTD DL"", type number}, {""YTD Fringe"", type number}, {""YTD Overhead"", type number}, {""YTD ODC"", type number}, {""YTD Subs"", " & _
        "type number}, {""YTD NSR"", type number}, {""YTD GM"", type number}, {""YTD GM % of Revenue"", type number}, {""YTD NM"", type number}, {""YTD DLM"", type number}, {""YTD SCM"", type number}, {""YTD Bookings"", type number}, {""ITD Revenue"", type number}, {""ITD Total Costs"", type number}, {""ITD DL"", type number}, {""ITD Fringe"", type number}, {""ITD Overhead""" & _
        ", type number}, {""ITD ODC"", type number}, {""ITD Subs"", type number}, {""ITD NSR"", type number}, {""ITD GM"", type number}, {""ITD GM% of Revenue"", type number}, {""ITD NM"", type number}, {""ITD DLM"", type number}, {""ITD SCM"", type number}, {""Funded Value"", type number}, {""Backlog"", type number}, {""Unbilled >30"", type number}, {""Unbilled (BIEE)"", ty" & _
        "pe number}, {""ITD Billed"", type number}, {""Billing > 60"", type number}, {""Trade AR"", type number}, {""Retention"", Int64.Type}, {""Appr Revenue Budget"", type number}, {""Appr ODC Budget"", type number}, {""Appr Subs Budget"", type number}, {""Appr Contingency Budget"", type number}, {""Appr DL Budget"", type number}, {""Appr Fringe Budget"", type number}, {""" & _
        "Appr Cost Budget"", type number}, {""Appr DLM Budget"", type number}, {""Appr SCM Budget"", type number}, {""Frcst Revenue Budget"", type number}, {""Frcst ODC Budget"", type number}, {""Frcst Subs Budget"", type number}, {""Frcst Contingency Budget"", type number}, {""Frcst DL Budget"", type number}, {""Frcst Fringe Budget"", type number}, {""Frcst Overhead Budget" & _
        """, type number}, {""Frcst Cost Budget"", type number}, {""Frcst DLM"", type number}, {""Frcst SCM"", type number}, {""Source System Description"", type text}, {""Source System ID"", Int64.Type}, {""Valid for Review?"", type text}, {""Project Accountant Required"", type text}, {""Invoiced Over Contract "", type number}, {""Est. Collections over Contact "", type numb" & _
        "er}, {""Current ETC "", type number}, {""Trended Costs"", Int64.Type}, {""Est. ETC at Month End"", type number}, {""MTD NM% of NSR"", type any}, {""YTD NM% of NSR"", type any}, {""ITD NM% of NSR"", type any}, {""Percent Complete"", type any}, {""Backlog Burn Rate"", type any}, {""Billing Backlog"", type number}, {""Unbilled Reserve"", type number}, {""AR Reserve"", " & _
        "type number}, {""YTD Lost Margin"", type number}, {""Project Manager Location"", type text}, {""ROCV"", type text}, {""Low to Zero Backlog"", type text}, {""Negative Margin MTD"", type text}, {""Negative Margin YTD"", type text}, {""Negative Margin ITD"", type text}})," & Chr(13) & "" & Chr(10) & "    #""Unpivoted Columns"" = Table.UnpivotOtherColumns(#""Changed Type"", {""Project"", ""Project" & _
        "2"", ""Project Name"", ""Strategic Business Unit"", ""Area"", ""Sub Area"", ""Business Line"", ""Department"", ""AECOM Project Review Category"", ""Customer Name"", ""Customer Type"", ""Project Manager"", ""Project Accountant"", ""Project Biller"", ""Regional Director"", ""Project Director"", ""Project Status"", ""End-Client Sector"", ""Global Business Line"", ""AEC" & _
        "OM Work"", ""AECOM Funding Source"", ""Distribution Rule"", ""Agreement"", ""CRM Tracking #"", ""Last Invoiced Date"", ""Last EAC Date"", ""Scheduled Start Date"", ""Scheduled Finish Date"", ""Forecast End Date"", ""AECOM Contract Type"", ""MTD Revenue"", ""MTD Total Costs"", ""MTD DL"", ""MTD Fringe"", ""MTD Overhead"", ""MTD ODC"", ""MTD Subs"", ""NSR MTD"", ""MTD" & _
        " GM"", ""MTD GM % of Revenues"", ""MTD NM"", ""Direct Labor Multiplier MTD"", ""Salary Cost Multiplier MTD"", ""MTD Bookings"", ""YTD Revenue"", ""YTD Total Costs"", ""YTD DL"", ""YTD Fringe"", ""YTD Overhead"", ""YTD ODC"", ""YTD Subs"", ""YTD NSR"", ""YTD GM"", ""YTD GM % of Revenue"", ""YTD NM"", ""YTD DLM"", ""YTD SCM"", ""YTD Bookings"", ""ITD Revenue"", ""ITD " & _
        "Total Costs"", ""ITD DL"", ""ITD Fringe"", ""ITD Overhead"", ""ITD ODC"", ""ITD Subs"", ""ITD NSR"", ""ITD GM"", ""ITD GM% of Revenue"", ""ITD NM"", ""ITD DLM"", ""ITD SCM"", ""Funded Value"", ""Backlog"", ""Unbilled >30"", ""Unbilled (BIEE)"", ""ITD Billed"", ""Billing > 60"", ""Trade AR"", ""Retention"", ""Appr Revenue Budget"", ""Appr ODC Budget"", ""Appr Subs Bu" & _
        "dget"", ""Appr Contingency Budget"", ""Appr DL Budget"", ""Appr Fringe Budget"", ""Appr Cost Budget"", ""Appr DLM Budget"", ""Appr SCM Budget"", ""Frcst Revenue Budget"", ""Frcst ODC Budget"", ""Frcst Subs Budget"", ""Frcst Contingency Budget"", ""Frcst DL Budget"", ""Frcst Fringe Budget"", ""Frcst Overhead Budget"", ""Frcst Cost Budget"", ""Frcst DLM"", ""Frcst SCM" & _
        """, ""Source System Description"", ""Source System ID"", ""Valid for Review?"", ""Project Accountant Required"", ""Invoiced Over Contract "", ""Est. Collections over Contact "", ""Current ETC "", ""Trended Costs"", ""Est. ETC at Month End"", ""MTD NM% of NSR"", ""YTD NM% of NSR"", ""ITD NM% of NSR"", ""Percent Complete"", ""Backlog Burn Rate"", ""Billing Backlog"", " & _
        """Unbilled Reserve"", ""AR Reserve"", ""YTD Lost Margin"", ""Project Manager Location""}, ""Attribute"", ""Value"")" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Unpivoted Columns"""
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""ProjectDetails (4)"";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [ProjectDetails (4)]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "ProjectDetails__4"
        .Refresh BackgroundQuery:=False
    End With
    Application.CommandBars("Queries and Connections").Visible = False
End Sub

推荐答案

没有更改我发布的链接中的 UnPivotData 函数，这应该可以根据您发布的文件执行您想要的操作:

With no changes to the UnPivotData function in the link I posted, this should do what you want, based on the file you posted:

Sub Tester()

    Dim p

    'get the unpivoted data as a 2-D array
    p = UnPivotData(ThisWorkbook.Sheets("data source").Range("A2").CurrentRegion, _
                  118, True, True)
    
    'I added a new sheet for the output
    With Sheets("output2")
        .Cells.ClearContents
        .Range("A1").Resize(UBound(p, 1), UBound(p, 2)).Value = p 'populate array to sheet
    End With

    'EDIT: alternative (slower) method to populate the sheet
    '      from the pivoted dataset.  Might need to use this
    '      if you have a large amount of data
'    Dim r As Long, c As Long
'    For r = 1 To UBound(p, 1)
'    For c = 1 To UBound(p, 2)
'        Sheets("Sheet2").Cells(r, c).Value = p(r, c)
'    Next c
'    Next r

End Sub

编辑 - 添加 UnPivotData 函数:

Function UnPivotData(rngSrc As Range, fixedCols As Long, _
                   Optional AddCategoryColumn As Boolean = True, _
                   Optional IncludeBlanks As Boolean = True)

    Dim nR As Long, nC As Long, data, dOut()
    Dim r As Long, c As Long, rOut As Long, cOut As Long, cat As Long
    Dim outRows As Long, outCols As Long
    
    data = rngSrc.Value 'get the whole table as a 2-D array
    nR = UBound(data, 1) 'how many rows
    nC = UBound(data, 2) 'how many cols

    'calculate the size of the final unpivoted table
    outRows = nR * (nC - fixedCols)
    outCols = fixedCols + IIf(AddCategoryColumn, 2, 1)
    
    'resize the output array
    ReDim dOut(1 To outRows, 1 To outCols)
               
    'populate the header row
    For c = 1 To fixedCols
        dOut(1, c) = data(1, c)
    Next c
    If AddCategoryColumn Then
        dOut(1, fixedCols + 1) = "Category"
        dOut(1, fixedCols + 2) = "Value"
    Else
        dOut(1, fixedCols + 1) = "Value"
    End If
    
    'populate the data
    rOut = 1
    For r = 2 To nR
        For cat = fixedCols + 1 To nC
            
            If IncludeBlanks Or Len(data(r, cat)) > 0 Then
                rOut = rOut + 1
                'Fixed columns...
                For c = 1 To fixedCols
                    dOut(rOut, c) = data(r, c)
                Next c
                'populate unpivoted values
                If AddCategoryColumn Then
                    dOut(rOut, fixedCols + 1) = data(1, cat)
                    dOut(rOut, fixedCols + 2) = data(r, cat)
                Else
                    dOut(rOut, fixedCols + 1) = data(r, cat)
                End If
            End If

        Next cat
    Next r
    
    UnPivotData = dOut
End Function

这篇关于如何像 Power Query 一样使用 VBA 旋转固定数量的列的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！