xml - Excel XML数据提要使行数据脱节

我有一个XML提要，它正在将按字母顺序排序的电子邮件地址列表绘制到表1中
在表2中，我在第1列中列出了电子邮件地址，然后在其他几列中列出了用户信息。
当我刷新数据并向列表中添加新电子邮件时，第1列中的电子邮件地址列表将下移，因此其他列中的数据不一致。如果在第1列中添加了新地址，我是否可以插入新行并向下移动所有列中的所有数据。类似地，如果从提要中删除了电子邮件，则删除一行数据。
我知道这是一个数据库，但我没有选择。
提前谢谢！

最佳答案

首先，由于缺乏信息，我将假设一个场景来工作，并尝试实现您所需要的。您可能需要稍微更改代码以满足您的需要，但这为您提供了工作的基础。
由于XML提要不包含其他数据，因此包含电子邮件地址的表不会按您的要求向表的其余部分添加行。我的建议是你用vba代码来完成这项工作。
假设您有以下XML文件：

<?xml version="1.0" encoding="UTF-8"?>
<Email>
    <address>[e-mail]</address>
    <address>[e-mail]</address>
    <address>[e-mail]</address>
    <address>[e-mail]</address>
    <address>[e-mail]</address>
    <address>[e-mail]</address>
</Email>

使用以下代码将在工作表上生成一个表：

Const xmlFileUrl As String = "c:\filePath\note.xml"
Sub ClearXmlMaps()

    Dim existingXmlMap As XmlMap

    For Each existingXmlMap In ActiveWorkbook.XmlMaps

       existingXmlMap.Delete

    Next existingXmlMap

End Sub

Sub CreateMailList()

    Dim xmlTable As XmlMap

    ClearXmlMaps

    Application.WindowState = xlNormal
    ActiveWorkbook.XmlImport URL:=xmlFileUrl, ImportMap:=Nothing, Overwrite:=True, Destination:=Range("$A$1")

    Set xmlTable = ActiveWorkbook.XmlMaps(1)

    xmlTable.Name = "EmailList"

End Sub

代码生成下表的红色方形部分：
我还添加了一个名为“name”的新列。现在假设我想刷新xml提要，而不清除列名上的所有信息。为此，我将使用一个辅助表（这里我的主表是“数据”，而辅助表是“辅助”表）来复制所有数据，刷新提要，最后，使用vlookup命令用最后一个状态重新填充表，如下所示：

Sub RefreshEmailList()

    Dim existingXmlMap As XmlMap
    Dim dataSheet As Worksheet
    Dim auxSheet As Worksheet

    Set dataSheet = ThisWorkbook.Worksheets("Data")
    Set auxSheet = ThisWorkbook.Worksheets("Aux")

    dataSheet.Cells.Copy auxSheet.Cells(1, 1)

    auxSheet.Range(auxSheet.Cells(1, 1), auxSheet.Cells(auxSheet.Cells(auxSheet.Rows.Count, 1).End(xlUp).Row, auxSheet.Cells(1, auxSheet.Columns.Count).End(xlToLeft).Column)).Value = auxSheet.Range(auxSheet.Cells(1, 1), auxSheet.Cells(auxSheet.Cells(auxSheet.Rows.Count, 1).End(xlUp).Row, auxSheet.Cells(1, auxSheet.Columns.Count).End(xlToLeft).Column)).Value


    dataSheet.Range(dataSheet.Cells(2, 2), dataSheet.Cells(dataSheet.Cells(dataSheet.Rows.Count, 1).End(xlUp).Row, dataSheet.Cells(1, dataSheet.Columns.Count).End(xlToLeft).Column)).Clear

    For Each existingXmlMap In ThisWorkbook.XmlMaps

        If existingXmlMap.Name = "EmailList" Then

            ActiveWorkbook.XmlMaps("EmailList").DataBinding.Refresh

        End If

    Next existingXmlMap

    dataSheet.Range(dataSheet.Cells(2, 2), dataSheet.Cells(dataSheet.Cells(dataSheet.Rows.Count, 1).End(xlUp).Row, dataSheet.Cells(1, dataSheet.Columns.Count).End(xlToLeft).Column)).FormulaR1C1 = "=IFERROR(IF(VLOOKUP([@address],Aux!C1:C,COLUMN(),FALSE) = 0 , """", VLOOKUP([@address],Aux!C1:C,COLUMN(),FALSE)), """")"
    dataSheet.Range(dataSheet.Cells(2, 2), dataSheet.Cells(dataSheet.Cells(dataSheet.Rows.Count, 1).End(xlUp).Row, dataSheet.Cells(1, dataSheet.Columns.Count).End(xlToLeft).Column)).Value = dataSheet.Range(dataSheet.Cells(2, 2), dataSheet.Cells(dataSheet.Cells(dataSheet.Rows.Count, 1).End(xlUp).Row, dataSheet.Cells(1, dataSheet.Columns.Count).End(xlToLeft).Column)).Value


End Sub

如果将XML文件更改为以下内容：

<?xml version="1.0" encoding="UTF-8"?>
<Email>
    <address>[e-mail]</address>
    <address>[e-mail]</address>
    <address>[e-mail]</address>
    <address>[e-mail]</address>
    <address>[e-mail]</address>
    <address>[e-mail]</address>
    <address>[e-mail]</address>
</Email>

然后运行refreshEmailList（）子例程，将得到以下结果：
上面的解决方案适用于添加或删除行，但您应该注意两件事：
使用刷新按钮刷新xml提要不会触发事件
此解决方案不保留旧状态，这意味着，如果删除一封电子邮件，然后重新添加，有关该用户的信息可能会丢失。