将非规范化数据从 excel 导出到 xml

Export denormalized data from excel to xml

提问by Martinffx

We are trying to export an excel table with "Denormalized Data" to xml. The table headers are as follows:

我们正在尝试将带有“非规范化数据”的 excel 表导出到 xml。表头如下：

| AssetManager Code | AssetManager Date | Portfolio Code | Portfolio Name | MarketValue | NetCashFlow | Field | Field Code | Field Name |

The AssetManager Code and AssetManager Date are the same throughout, the rest of the columns contain variable data.

AssetManager Code 和 AssetManager Date 始终相同，其余列包含可变数据。

Here is an example of the xml output we want:

这是我们想要的 xml 输出示例：

<AssetManager Code="PFM" Date="20130117">                   
    <Portfolios>            
        <Portfolio Code="CC PSP" Name="Consilium Capital">      
            <MarketValue>5548056.51</MarketValue>   
            <NetCashFlow>0</NetCashFlow>    
            <UserFields>    
                <Field Code="AM UCGT" Name="AM daily Unrealised CG">4375</Field>
            </UserFields>   
        </Portfolio>        
        <Portfolio Code="MM (FC)" Name="Money Market UT (FC)">      
            <MarketValue>28975149.6500735</MarketValue> 
            <NetCashFlow>0</NetCashFlow>    
            <UserFields>    
                <Field Code="UCGT" Name="AM daily Unrealised CG">0</Field>
            </UserFields>   
        </Portfolio>        
    </Portfolios>           
</AssetManager> 

And our xsd file containing the mappings:

我们的 xsd 文件包含映射：

<?xml version="1.0" encoding="UTF-8"?>
<xs:schema xmlns:xs="http://www.w3.org/2001/XMLSchema">
<xs:element name="AssetManager">
    <xs:complexType>
        <xs:sequence>
                    <xs:element ref="Portfolios" />
            </xs:sequence>
        <xs:attribute name="Code" type="xs:string"/>
            <xs:attribute name="Date" type="xs:string"/>
    </xs:complexType>
</xs:element>
<xs:complexType name="FieldType">
    <xs:simpleContent>
        <xs:extension base="xs:decimal">
            <xs:attribute name="Code" type="xs:string"/>
                <xs:attribute name="Name" type="xs:string"/>
        </xs:extension>
    </xs:simpleContent>
</xs:complexType>
<xs:element name="Portfolios">
  <xs:complexType>
    <xs:sequence>
      <xs:element name="Portfolio">
    <xs:complexType>
      <xs:sequence>
        <xs:element name="MarketValue" type="xs:decimal"/>
        <xs:element name="NetCashFlow" type="xs:decimal"/>
        <xs:element name="UserFields">
          <xs:complexType>
            <xs:sequence>
                    <xs:element name="Field" type="FieldType"/>
            </xs:sequence>
          </xs:complexType>
        </xs:element>
      </xs:sequence>
      <xs:attribute name="Code" type="xs:string"/>
      <xs:attribute name="Name" type="xs:string"/>
    </xs:complexType>
              </xs:element>
            </xs:sequence>
    </xs:complexType>
  </xs:element>
</xs:schema>

At the very least we'd like to know why excel considers data denormalised?

至少我们想知道为什么 excel 认为数据是非规范化的？

Any help will be much appreciated.

任何帮助都感激不尽。

回答by Petru Gardea

First of all, you have a problem with the posted XSD. The Portfolio should have the maxOccurs set to a value greater than 1 - otherwise you're not matching the sample XML and you wouldn't get the "denormalized data" error when verifying your map in Excel.

首先，您发布的 XSD 有问题。Portfolio 应将 maxOccurs 设置为大于 1 的值 - 否则您与示例 XML 不匹配，并且在 Excel 中验证您的地图时不会收到“非规范化数据”错误。

This articleshould explain common errors you get with Excel maps - yours included.

本文应解释您使用 Excel 地图遇到的常见错误 - 包括您的错误。

I guess what you did was to drag-drop the root - this will not work with repeating elements.

我猜你所做的是拖放根 - 这不适用于重复元素。

You may get around with what I did below; it may not work for your concrete example, but it should give you an idea.

你可以解决我在下面所做的事情；它可能不适用于您的具体示例，但它应该给您一个想法。

Modified your XSD to account for repeating particles:

修改您的 XSD 以考虑重复粒子：

<?xml version="1.0" encoding="UTF-8"?>
<!-- XML Schema generated by QTAssistant/XSD Module (http://www.paschidev.com) -->
<xs:schema xmlns:xs="http://www.w3.org/2001/XMLSchema">
    <xs:element name="AssetManager">
        <xs:complexType>
            <xs:sequence>
                <xs:element ref="Portfolios"/>
            </xs:sequence>
            <xs:attribute name="Code" type="xs:string"/>
            <xs:attribute name="Date" type="xs:string"/>
        </xs:complexType>
    </xs:element>
    <xs:complexType name="FieldType">
        <xs:simpleContent>
            <xs:extension base="xs:decimal">
                <xs:attribute name="Code" type="xs:string"/>
                <xs:attribute name="Name" type="xs:string"/>
            </xs:extension>
        </xs:simpleContent>
    </xs:complexType>
    <xs:element name="Portfolios">
        <xs:complexType>
            <xs:sequence>
                <xs:element name="Portfolio" minOccurs="0" maxOccurs="unbounded">
                    <xs:complexType>
                        <xs:sequence>
                            <xs:element name="MarketValue" type="xs:decimal"/>
                            <xs:element name="NetCashFlow" type="xs:decimal"/>
                            <xs:element name="UserFields">
                                <xs:complexType>
                                    <xs:sequence>
                                        <xs:element name="Field" type="FieldType"/>
                                    </xs:sequence>
                                </xs:complexType>
                            </xs:element>
                        </xs:sequence>
                        <xs:attribute name="Code" type="xs:string"/>
                        <xs:attribute name="Name" type="xs:string"/>
                    </xs:complexType>
                </xs:element>
            </xs:sequence>
        </xs:complexType>
    </xs:element>
</xs:schema>

Drag the Code and Date only on the first sheet; rename that to something else if you want.

仅在第一张纸上拖动代码和日期；如果需要，将其重命名为其他名称。

Drag Portfolios to another sheet.

将投资组合拖到另一个工作表。

Fill in some data and Export; this is what I got:

填写一些数据并导出；这就是我得到的：

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<AssetManager Code="a" Date="b">
    <Portfolios>
        <Portfolio Code="aa" Name="bb">
            <MarketValue>10</MarketValue>
            <NetCashFlow>100</NetCashFlow>
            <UserFields>
                <Field/>
            </UserFields>
        </Portfolio>
        <Portfolio Code="aa" Name="bb">
            <MarketValue>10</MarketValue>
            <NetCashFlow>100</NetCashFlow>
            <UserFields>
                <Field/>
            </UserFields>
        </Portfolio>
    </Portfolios>
</AssetManager>

It looks pretty close. It should help you move forward if not with the solution itself, then with your investigations.

它看起来很接近。如果不是解决方案本身，那么它应该可以帮助您前进，然后是您的调查。

回答by DBexcel

I wrote up some code to write a pivot table to a primitive XML format. Here I am not following any pre-set schema, just writing the pivot table heirarchy to XML. For this to work, you must use the outline form but not-compact (each new level should start a new column). Also the code expects no subtotals or grand totals, and only one level of numeric data in the data field is expected.

我编写了一些代码来将数据透视表写入原始 XML 格式。在这里，我没有遵循任何预设模式，只是将数据透视表层次结构写入 XML。为此，您必须使用大纲形式但不紧凑（每个新级别应开始一个新列）。此外，该代码不需要小计或总计，并且只需要数据字段中的一级数字数据。

Your PT will be in an acceptable XML format with nodes named according to the PT headers, but the sub group titles come out as attributes unhelpfully named 'name ='. So you get XML that reads like - "Folder contents here".

您的 PT 将采用可接受的 XML 格式，其中节点根据 PT 标题命名，但子组标题作为无用的属性命名为“name =”。所以你得到的 XML 读起来像 - “此处的文件夹内容”。

See code below: one other caveat, this has not been cleaned up very well. there are some lines that will never get hit from old implementations of the code. Also, there is a stop right before the end for debugging - in case you need to make a change to the output and redo the file writing steps. Output is written as a text file named 'txt.txt' in the C: drive.

请参阅下面的代码：另一个警告，这还没有得到很好的清理。有一些行永远不会被代码的旧实现所命中。此外，在调试结束之前有一个停止点 - 以防您需要更改输出并重做文件写入步骤。输出在 C: 驱动器中写入为名为“txt.txt”的文本文件。

Edit and re-use as needed.

根据需要进行编辑和重复使用。

Private Sub XMLWriter()
Dim sht As Worksheet: Set sht = ActiveSheet
    'Debug.Print "The current Sheet is " & sht.Name
Dim pt As PivotTable: Set pt = sht.PivotTables(1)
    'Debug.Print "Pivot Table name is " & pt.Name
Dim begin As String: begin = pt.TableRange1.Cells(1, 1).Address

Dim rows As Integer: rows = pt.TableRange1.rows.Count
Dim LastCell As Range: Set LastCell = pt.TableRange1.Cells(rows, 1)

 If LastCell.PivotCell.PivotCellType = xlPivotCellGrandTotal Then Set LastCell = LastCell.Offset(-1, 0)
 If LastCell.PivotCell.PivotCellType = xlPivotCellSubtotal Then Stop 'not implemented routine does not expect subtotals in rows - (will not create good xml)

Dim LastRow As Integer: LastRow = LastCell.Row

Dim celly As Range: Set celly = sht.Range(begin)
Dim level As Integer: level = 1
Dim levels As Integer: levels = 0 ' PRECEEDING CODE INITIALIZED VARIABLES - Depends on Pivot table in active worksheet (first on sheet, assumes only one on sheet)

Do 'determines nesting depth
    If celly.Offset(0, levels + 1).Value = "" Then
        levels = levels + 1
        Exit Do
    Else: levels = levels + 1
    End If
Loop
'Stop
Dim dataFieldPresent As Boolean
Dim ShutDown As Boolean
If celly.Offset(levels - 1, levels - 1).PivotCell.PivotCellType = xlPivotCellValue Then
levels = levels - 1
dataFieldPresent = True
End If
'Stop


Dim ary() As String ' initializes array
ReDim ary(1 To levels, 7) As String ' based on nesting depth, seven placeholders set to accomadate data
Dim n As Integer
For n = LBound(ary) To UBound(ary)      ' populates 'folder' names from pivottable headings
    ary(n, 0) = celly.Offset(0, n - 1).Value  ' 0 based folder holds name, or already completed xml group's string/data
    ary(n, 1) = gettabs(n) & Cap(ary(n, 0))          ' 1 based folder holds node's'front cap' following xml syntax
    ary(n, 2) = Cap("/" & ary(n, 0)) & vbCrLf   ' 2 based folder holds 'end cap' to close node
    ary(n, 0) = ""
Next

Set celly = celly.Offset(1, 0)
If celly.Value = "" Then Stop ' error occurred, there must be a cell in first column position at first row under Row Heading

ary(level, 3) = nameElement(celly.Value) & vbCrLf ' get value in current cell to name folder   'ary(level, 4) = nameElement("/" & celly.Value) ' level 4 was created for old implementation, no longer used

Dim tabs As String
'Stop
'tabs = gettabs(level)
ary(level, 6) = ary(level, 2) & vbCrLf
ary(level, 5) = ary(level, 1) & ary(level, 3) & vbCrLf

Dim lvlref As Integer: lvlref = 1
Dim addcrlf As String: addcrlf = vbCrLf

Do
    Set celly = celly.Offset(1, -(celly.Column - 1))
'    If celly.Row = 780 Then Stop

    If celly.Row = LastRow Then ShutDown = True


    If celly.Value = "Liabilities" Then Stop
    If Not celly.Value = "" Then
        closetoplevel
        level = 1
        ary = levelup(ary, level, lvlref, levels)
            ary(level, 3) = nameElement(celly.Value) & vbCrLf
 '           ary(level, 4) = nameElement("/" & celly.Value)
            ary(level, 5) = ary(level, 5) & gettabs(level) & ary(level, 3)
            ary(level, 6) = ary(level, 3)
            ary(level, 7) = celly.Value
        writeout ary(1, 0)
'        Stop
    Else
        level = 2
        Do
            Set celly = celly.Offset(0, 1)
             On Error GoTo Term:
             Nam = celly.PivotCell.PivotCellType ' error trap - should always be in pivot table
            On Error GoTo 0
            If celly.Value = "" Then
                level = level + 1
            Else
                Exit Do
            End If
        Loop

        getPosition (celly.Cells(1))

'        If level = lvlref And level > 2 Then Stop ' update: seems to work fine after refactoring code originally ('not implemented - code does not expect given schema structure"
        If level < lvlref Then
            'Stop
            ary = levelup(ary, level, lvlref, levels)
            'getPosition (celly.Cells(1))
            'Stop
            lvlref = level - 1
            GoTo ReInsertionPoint:


        Else


ReInsertionPoint:







            If level = levels Then
                addcrlf = ""
            Else: addcrlf = vbCrLf
            End If

            ary(level, 3) = nameElement(celly.Value) & addcrlf
            If level = levels And dataFieldPresent = True Then
'                Stop
                ary(level, 3) = ary(level, 3) & CStr(celly.Offset(0, 1).Value)
            End If
            ary(level, 5) = ary(level, 5) & ary(level, 3)
            ary(level, 6) = ary(level, 3)
            ary(level, 7) = celly.Value

         If level = levels Then ' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  not operating properly failing to add last item (number & accoiunt) of each section
'            Stop

                Dim nextlevel As Integer: nextlevel = 1
                'Stop
                Dim nextlvlcell As Range: Set nextlvlcell = celly.Offset(1, -(level - 1))
                Debug.Print nextlvlcell.Address
                Do
                    If nextlvlcell.Value = "" Then
                        If nextlvlcell.Row > LastRow Then
                            nextlevel = 1
                            GoTo Closure:
                        Else
                            Set nextlvlcell = nextlvlcell.Offset(0, 1)
                            nextlevel = nextlevel + 1
                        End If
                    Else: Exit Do
                    End If
                Loop
                Debug.Print nextlvlcell.Address
                If level - nextlevel > 1 Then
Closure:
                    'Stop
                    ary = pushup(ary(), level, levels, lvlref)
                    'Stop
                    ary = levelup(ary(), level - 1, levels, lvlref)
                Else

                    ary = pushup(ary, level, levels, lvlref)
                End If
            End If

        'Stop

        End If
    End If
lvlref = level
If ShutDown = True Then
    level = 1
    ary = levelup(ary, level, lvlref, levels)
    Exit Do
End If
Loop

writeout "<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & vbCrLf & "<Root xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"">" & vbCrLf & ary(1, 0) & "</Root>"

Stop
End
Term:
Stop

writeout "<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & vbCrLf & "<Root xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"">" & vbCrLf & "<xmldoc>" & vbCrLf & ary(1, 0) & "</xmldoc>" & vbCrLf & "</Root>"
'writeout (ary(1, 0))
Stop
Exit Sub
'created by derik bingner Jan 2014 www.dbexcelaccounting.blogspot.com

End Sub
Private Sub getPosition(x As Range)
Debug.Print "Cell addy is " & x.Address & ". Cell level and text is " & x.Column & " - " & x.Value
End Sub
Private Function gettabs(x As Integer, Optional y As Integer) As String
For n = 1 To (x) ' - y) old implementation allowed offsets
gettabs = vbTab & "" & gettabs
Next
'If ((x * 2) - y) = 8 Then Stop

End Function

Private Function cnam(c As Range)
cnam = c.Value
End Function
Private Function Cap(x As String) As String
If Left(x, 1) = "/" Then
Cap = "</" & Right(x, Len(x) - 1) & ">"
Else: Cap = "<" & x & " name="""
End If
End Function
Private Function nameElement(x As String) As String
nameElement = x & """>"
End Function

Private Sub closetoplevel()
'Stop
'not implemented
End Sub

Private Function pushup(r() As String, l As Integer, s As Integer, ref As Integer)
Dim x As Integer: x = ref - l - 1
'Stop



'If ref <> s Then
'    MsgBox "error, structure issue - not implemented"
'    Stop
'End If
Dim y As Integer
If x > 1 Then ' tests if this function needs to be run recursively to step up multiple levels
    For y = 1 To x - 1
    Dim groupnumber As Integer
    'Stop
    If y <> 2 And InStr(1, r(l + 1, 0), "<") > 0 Then
        groupnumber = 2
    Else: groupnumber = 2 + y - 1
    End If
    'If groupnumber = 2 Then Stop
    Call rlevelup(r, l + (x - y), s, ref, groupnumber) ' recursive section
    'Stop
    Next
End If
'Stop
If r(l, 5) = r(l, 3) Then ' this triggers for first item in group
    'Stop
    r(l, 5) = r(l, 1) & r(l, 5) & r(l, 2)
Else
    If y = 0 Then
    r(l, 5) = r(l, 1) & r(l, 5) & r(l, 2) & vbCrLf
    Stop
    Else
        r(l, 5) = r(l, 5) & vbCrLf & r(l + 1, 5) & vbCrLf & gettabs(l, -1) & r(l, 4) & vbCrLf
'        Stop
    End If
End If

'Debug.Print r(l, 5)
Dim PlaceHolder As String: PlaceHolder = r(l, 0)

    If Left(PlaceHolder, 1) = vbTab Or Left(PlaceHolder, 4) = "    " Or Left(PlaceHolder, 1) = "<" Then
        'Debug.Print PlaceHolder
    Else
        PlaceHolder = ""
    End If

r(l, 0) = PlaceHolder & r(l, 5)
'Stop
For n = LBound(r) To UBound(r)
    If n >= l Then
        For i = 3 To 7
            If r(n, i) <> r(l, 5) Then r(n, i) = ""
        Next
    End If
Next

r(l, 3) = r(l, 5)
r(l, 5) = ""


'Stop
'not implemented

pushup = r
End Function

Private Function levelup(r() As String, l As Integer, s As Integer, ref As Integer)
Dim x As Integer: x = s - l - 1
'If x > 3 Then Stop
'r = pushup(r(), s - 1, s, ref)


'If ref <> s Then
'    MsgBox "error, structure issue - not implemented"
'    Stop
'End If
Dim y As Integer
If x > 1 Then ' tests if this function needs to be run recursively to step up multiple levels
    For y = 1 To x - 1
    Dim groupnumber As Integer
    'Stop
    If y <> 2 And InStr(1, r(l + 1, 0), "<") > 0 Then
        groupnumber = 2
    Else: groupnumber = 2 + y - 1
    End If
'Stop
    'If groupnumber = 2 Then Stop
    Call rlevelup(r, l + (x - y), s, ref, groupnumber) ' recursive section
    'Stop
    Next
End If
'Stop
If r(l, 5) = r(l, 3) Then ' this triggers for first item in group
    'Stop
    r(l, 5) = r(l, 1) & r(l, 5) & gettabs(l) & r(l, 2) & vbCrLf
Else
    If y = 0 Then
    r(l, 5) = r(l, 1) & r(l, 5) & gettabs(l) & r(l, 2) & vbCrLf
    Stop
    Else
        r(l, 5) = r(l, 5) & vbCrLf & r(l + 1, 5) & vbCrLf & gettabs(l, -1) & r(l, 4) & vbCrLf
'        Stop
    End If
End If

'Debug.Print r(l, 5)
Dim PlaceHolder As String: PlaceHolder = r(l, 0)

    If Left(PlaceHolder, 1) = vbTab Or Left(PlaceHolder, 4) = "    " Or Left(PlaceHolder, 1) = "<" Then
        'Debug.Print PlaceHolder
    Else
        PlaceHolder = ""
    End If

r(l, 0) = PlaceHolder & r(l, 1) & r(l, 3) & r(l + 1, 0) & gettabs(l) & r(l, 2)
r(l + 1, 0) = ""
'Stop
For n = LBound(r) To UBound(r)
    If n >= l Then
        For i = 3 To 7
            If r(n, i) <> r(l, 5) Then r(n, i) = ""
        Next
    End If
Next

'r(l, 3) = r(l, 5)
r(l, 5) = ""


'Stop
'not implemented

levelup = r
End Function




Private Function rlevelup(r() As String, l As Integer, s As Integer, ref As Integer, Optional groupnumber As Integer)
Dim x As Integer: x = ref - l - 1
'Stop
'called by level up


'If ref <> s Then
'    MsgBox "error, structure issue - not implemented"
'    Stop
'End If
Dim y As Integer
If x > 1 Then ' tests if this function needs to be run recursively to step up multiple levels
    For y = 1 To x - 1
    'Dim groupnumber As Integer
    'Stop
    'If y <> 2 And InStr(1, r(l + 1, 0), "<") > 0 Then
        groupnumber = 2
    'Else: groupnumber = 2 + y - 1
    'End If
    'If groupnumber = 2 Then Stop
    'Call rpushup(r, l + (x - y), s, ref, groupnumber) ' recursive section
    'Stop
    Next
End If
'Stop
If r(l, 5) = r(l, 3) Then ' this triggers for first item in group
    'Stop
    r(l, 5) = r(l, 1) & r(l, 5) & gettabs(l) & r(l, 2) & vbCrLf
Else
    If y = 0 Then
    r(l, 5) = r(l, 1) & r(l, 5) & gettabs(l) & r(l, 2) & vbCrLf
    Stop ' delete this comment when stop hit programmatically - may be deletable
    Else
        r(l, 5) = r(l, 5) & vbCrLf & r(l + 1, 5) & vbCrLf & gettabs(l, -1) & r(l, 4) & vbCrLf
'        Stop
    End If
End If

'Debug.Print r(l, 5)
Dim PlaceHolder As String: PlaceHolder = r(l, 0)

    If Left(PlaceHolder, 1) = vbTab Or Left(PlaceHolder, 4) = "    " Or Left(PlaceHolder, 1) = "<" Then
        'Debug.Print PlaceHolder
    Else
        PlaceHolder = ""
    End If

r(l, 0) = PlaceHolder & r(l, 1) & r(l, 3) & r(l + 1, 0) & gettabs(l) & r(l, 2)
r(l + 1, 0) = ""
'Stop
For n = LBound(r) To UBound(r)
    If n >= l Then
        For i = 3 To 7
            If r(n, i) <> r(l, 5) Then r(n, i) = ""
        Next
    End If
Next

'r(l, 3) = r(l, 5)
r(l, 5) = ""


'Stop
'not implemented
'writeout (r(l, 0))
rlevelup = r
End Function

Private Sub writeout(s As String)

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oFile As Object
Set oFile = fso.CreateTextFile("c:/txt.txt")
oFile.WriteLine s
oFile.Close
Set fso = Nothing
Set oFile = Nothing

End Sub