在Excel中转 换具有节点级别的表

问题描述 投票:0回答:2

我怎样才能实现从表1到表2的数据转换。

在这种情况下,“= offset()”公式可以帮助吗?

enter image description here

Link to excel file

excel transformation
2个回答
2
投票

这个问题困在我脑海里。无法抗拒解决它。首先,计算一行中的唯一值(节点+父节点)。在单元格N3中输入公式并填写它:=SUMPRODUCT(1/COUNTIF(B3:L3,B3:L3&""))

关于公式如何运作的详细信息:https://exceljet.net/formula/count-unique-values-in-a-range-with-countif

接下来,转到L15并为每个级别插入编号:1为父级,2 - 节点1,...,11 - 节点10。

在L17中输入公式并将其复制到整个范围B17:J25

=IF(L$15<=$N3,OFFSET($B3,0,$N3-L$15);"")

该公式以下列方式工作。它锚定每行的节点10值。根据行中有多少唯一值,它从左到右提取值。例如,如果Apple行(包括Parent)中有4个唯一值,则公式将仅从列B,C,D,E中提取值。

我可能缺乏描述这个过程的文字,看一下表:https://www.dropbox.com/s/n1y53v3nye3n47p/Transform%20Table.xlsx?dl=0

Finally, Table 2 looks like this


0
投票

所以这是我为解决问题而编写的代码:

Sub MacroTest()

Dim iVal As Integer
Dim SearchValue As String
Dim WholeRange As String
Dim RangePart As String
Dim EndColumnToCut As Integer
Dim PasteCell As String

Application.ScreenUpdating = False 'Turn off window update while running macro

X = 3 'Row to start from
Y = 12 'Column Value where the table ends


Do Until IsEmpty(Cells(X, Y)) 'Start at Row X and loop through column Y

If IsError(ActiveSheet.Cells(X, Y)) Then 'Check if cell(X,Y) returns error code, if yes then skip current code
    GoTo NextRow
Else
    SearchValue = ActiveSheet.Cells(X, Y).Value 'Find the value in cell (X,Y)


    iVal = Application.WorksheetFunction.CountIf(Range("B" & X, "L" & X), SearchValue) 'Count how many times the value in "SearchValue" appears (You want to remove duplicates and leave one unique value)
    Cells_To_Remove = iVal - 1 'delete all cells with the same value except one

        If Cells_To_Remove = 0 Then 'If "Cells_To_Remove" is equal to 0, i.e. there are no cells to remove, then go to next row
            GoTo NextRow 'Skip cut and paste values and jump to next row

        Else

            RemoveValuesInRange = Range(Cells(X, Y - Cells_To_Remove + 1), Cells(X, Y)).ClearContents 'Clear Contents in the range
            RemoveFormatInRange = Range(Cells(X, Y - Cells_To_Remove + 1), Cells(X, Y)).ClearFormats 'Clear formats in range


            EndColumnToCut = Y - Cells_To_Remove 'Define the last column in range to cut data
            RangePart = Range(Cells(X, 2), Cells(X, EndColumnToCut)).Select 'Define the whole range where the data should be cut
            Selection.Cut 'Cut data

            PasteCell = Cells(X, 2 + Cells_To_Remove).Select 'Define the cell where to paste the data
            ActiveSheet.Paste 'Paste Data

        End If
End If
GoTo NextRow 'Jump to next row
NextRow:
  X = X + 1 'Jump to next row
Loop
End Sub
© www.soinside.com 2019 - 2024. All rights reserved.