如何在Excel或LibreOffice中转换指定结构的表格？

方法复杂度分析 #

• 公式法：如果数据量不大、结构稳定，完全不算复杂。尤其是Excel 365或LibreOffice 7+支持动态数组函数的情况下，几步就能搞定；但如果用旧版本，公式会繁琐些，需要手动处理表头或嵌套多函数。适合一次性小数据操作。
• VBA宏：如果是需要重复执行的场景（比如每周都要转换同格式数据），或者数据量极大，那完全不小题大做，反而能大幅节省时间。但如果只是单次小批量数据，确实没必要写代码，公式或手动处理更快。

公式法实现步骤 #

适用Excel 365/LibreOffice 7+（支持动态数组） #

1. 提取基础Object行
   在新表的A1单元格输入：
   Excel：=UNIQUE(FILTER(原表!A:C, 原表!C:C="Object"))
   LibreOffice：=UNIQUE(FILTER(原表!A:C; 原表!C:C="Object"))
   替换「原表」为你的数据源工作表名称，这会自动生成所有Type为Object的唯一行。
2. 提取Property作为新表头
   在新表的D1单元格输入：
   Excel：=UNIQUE(FILTER(原表!B:B, 原表!C:C="Property"))
   LibreOffice：=UNIQUE(FILTER(原表!B:B; 原表!C:C="Property"))
   这会自动列出所有唯一的Property项作为新列的表头。
3. 匹配标记True/False
   在新表的D2单元格输入：
   Excel：=NOT(ISERROR(XMATCH($A2&D$1, 原表!A:A&原表!B:B)))
   LibreOffice：=NOT(ISERROR(XMATCH($A2&D$1; 原表!A:A&原表!B:B)))
   然后下拉、右拉填充所有单元格——逻辑是把当前行的Unit number和表头的Property组合，在原表中查找是否存在对应关系，存在则返回True。

适用旧版本Excel/LibreOffice（无动态数组） #

1. 手动筛选原表中Type为Object的行，复制到新表作为基础数据；手动整理所有Property项，作为新表的表头。
2. 在第一个数据单元格（比如D2）输入：
   Excel：=IF(COUNTIFS(原表!A:A, $A2, 原表!B:B, D$1, 原表!C:C, "Property")>0, TRUE, FALSE)
   LibreOffice：=IF(COUNTIFS(原表!A:A; $A2; 原表!B:B; D$1; 原表!C:C; "Property")>0; TRUE; FALSE)
   下拉右拉填充即可。

VBA宏实现提示（Excel专属） #

如果需要自动化处理，以下是核心逻辑和简化代码：

Sub ConvertTable()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim lastRow As Long, i As Long, j As Long
    Dim unitDict As Object, propDict As Object
    
    '替换为你的原表名称
    Set wsSource = ThisWorkbook.Sheets("原表")
    Set wsTarget = ThisWorkbook.Sheets.Add
    Set unitDict = CreateObject("Scripting.Dictionary")
    
    '第一步：遍历原表，按Unit收集Object和Property
    lastRow = wsSource.Cells(Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRow '假设表头在第1行
        Dim unitNum As String, typeVal As String, nameVal As String
        unitNum = wsSource.Cells(i, "A").Value
        typeVal = wsSource.Cells(i, "C").Value
        nameVal = wsSource.Cells(i, "B").Value
        
        If Not unitDict.Exists(unitNum) Then
            Set unitDict(unitNum) = CreateObject("Scripting.Dictionary")
            unitDict(unitNum)("Objects") = New Collection
            unitDict(unitNum)("Properties") = New Collection
        End If
        
        If typeVal = "Object" Then
            unitDict(unitNum)("Objects").Add nameVal
        ElseIf typeVal = "Property" Then
            '避免重复添加Property
            On Error Resume Next
            unitDict(unitNum)("Properties").Add nameVal, Key:=nameVal
            On Error GoTo 0
        End If
    Next i
    
    '第二步：写入目标表表头
    wsTarget.Cells(1, 1).Value = "Unit number"
    wsTarget.Cells(1, 2).Value = "Type"
    wsTarget.Cells(1, 3).Value = "Name"
    
    '收集所有唯一Property作为表头列
    Set propDict = CreateObject("Scripting.Dictionary")
    For Each key In unitDict.Keys
        For Each prop In unitDict(key)("Properties")
            propDict(prop) = ""
        Next prop
    Next key
    
    Dim propArr() As String: propArr = propDict.Keys
    For j = 1 To UBound(propArr) + 1
        wsTarget.Cells(1, 3 + j).Value = propArr(j - 1)
    Next j
    
    '第三步：写入数据并标记Property
    Dim targetRow As Long: targetRow = 2
    For Each unitKey In unitDict.Keys
        For Each objName In unitDict(unitKey)("Objects")
            wsTarget.Cells(targetRow, 1).Value = unitKey
            wsTarget.Cells(targetRow, 2).Value = "Object"
            wsTarget.Cells(targetRow, 3).Value = objName
            
            '逐个检查Property是否存在
            For j = 1 To UBound(propArr) + 1
                Dim hasProp As Boolean: hasProp = False
                For Each p In unitDict(unitKey)("Properties")
                    If p = propArr(j - 1) Then
                        hasProp = True
                        Exit For
                    End If
                Next p
                wsTarget.Cells(targetRow, 3 + j).Value = hasProp
            Next j
            targetRow = targetRow + 1
        Next objName
    Next unitKey
    
    '自动调整列宽
    wsTarget.UsedRange.Columns.AutoFit
End Sub

使用时替换代码中的「原表」为你的数据源工作表名称，执行宏即可自动生成目标表。

内容的提问来源于stack exchange，提问作者Megidd