Excel XML数据Feed使行数据脱节

Question

我有一个XML Feed，它将按字母顺序排列的电子邮件地址列表绘制到Sheet 1

中

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

当我刷新数据并将新电子邮件添加到列表中时，第1列中的电子邮件地址列表向下移动，因此其他列中的数据不在线。无论如何，如果将新地址添加到第1列中，我可以插入新行并在所有列中向下移动所有数据。同样，如果从源中删除了电子邮件，则删除一行数据。

我知道这真的是在数据库中，但我没有这个选项。

提前致谢！

Answer 1

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

由于您的XML Feed不包含其他数据，因此包含电子邮件地址的表不会根据需要向表的其余部分添加行。我的建议是你使用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

代码生成下表中的红色平方部分：

我添加了一个名为“Name”的新列。现在假设我想刷新我的XML feed而不清除列名的所有信息。为此，我将使用辅助工作表（我的主要工作表是“数据”，辅助工具是“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不会触发事件
• 此解决方案不会保留旧状态，这意味着，如果删除了一封电子邮件然后重新添加，则该用户的相关信息可能会丢失。

Answer 2

您可以将传入的数据放入“保留区域”（单独的工作表或数组，具体取决于您更熟悉的数据），而不是自动刷新列。

然后，您可以比较两个列表以检查新电子邮件地址（将它们添加到现有数据的末尾）或传入数据中不再存在的电子邮件地址（从现有数据中删除行）。

Answer 3

要插入一个新行（并将每一列向下移动），您可以使用此VBA代码：

ActiveCell.EntireRow.Insert xlShiftDown

ActiveCell是新行应该出现的行中的一个单元格（范围）：如果需要添加第5个空行，则ActiveCell.Row应为= 5.

要删除整行，代码将为：

ActiveCell.EntireRow.Delete xlShiftUp

ActiveCell是要删除的行中的单元格（范围）