Excel XML数据Feed使行数据脱节

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

该代码生成了下表的红色方块部分：

我添加了一个名为“名称”的新列。现在假设我想要刷新 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 将不会触发该事件
• 此解决方案不会保留旧状态，这意味着，如果删除然后重新添加一封电子邮件，则有关该用户的信息可能会丢失。