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

Question

我有一个 XML 提要，它正在将按字母顺序排序的电子邮件地址列表绘制到工作表 1 中

在工作表 2 中，我在第 1 列中列出了电子邮件地址，然后在其他几列中包含了用户信息。

当我刷新数据并将新电子邮件添加到列表时，第 1 列中的电子邮件地址列表向下移动，因此其他列中的数据不一致。如果新地址被添加到第 1 列，我是否可以插入一个新行并将所有列中的所有数据向下移动。类似地，如果从提要中删除电子邮件，则删除一行数据。

我知道这真的意味着要在数据库中，但我没有那个选项。

提前致谢!

Answer 1

首先，由于缺乏信息，我将假设一个工作场景并尝试实现您的需求。您可能需要稍微更改代码以满足您的需要，但这为您提供了工作基础。

由于您的 XML 提要不包含其他数据，因此包含电子邮件地址的表格不会按照您的需要向表格的其余部分添加行。我的建议是您使用 vba 代码为您完成这项工作。

假设您有以下 xml 文件:

<?xml version="1.0" encoding="UTF-8"?>
<Email>
    <address>teste@teste.com</address>
    <address>teste1@teste.com</address>
    <address>teste2@teste.com</address>
    <address>teste3@teste.com</address>
    <address>teste4@teste.com</address>
    <address>teste6@teste.com</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

代码生成了下表的红色方 block 部分:

我还添加了一个名为“名称”的新列。现在假设我想刷新我的 XML 提要而不清除列名称上的所有信息。为此，我将使用辅助表(我的主表是“数据”，辅助表是“Aux”表)复制所有数据，刷新提要，最后，使用最后的状态重新填充我的表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>teste@teste.com</address>
    <address>teste1@teste.com</address>
    <address>teste2@teste.com</address>
    <address>teste3@teste.com</address>
    <address>teste4@teste.com</address>
    <address>teste5@teste.com</address>
    <address>teste6@teste.com</address>
</Email>

然后运行 ​​RefreshEmailList() 子例程，您将得到如下结果:

上面的解决方案适用于添加或删除行，但您应该注意两件事:

• 使用刷新按钮刷新 XML Feed 不会触发事件
• 此解决方案不会保留旧状态，这意味着，如果删除一封电子邮件然后重新添加，有关该用户的信息可能会丢失。