请求调整VBA代码，从Excel数据生成指定格式XML文件

核心修改说明 #

• 移除XML命名空间及所有多余属性
• 构建<Produtos>根节点，按行生成<Item_1>、<Item_2>等序号化子节点
• 每个Item节点仅包含当前行的<UF>与<CHAVE>节点，修正原循环重复添加所有行数据的问题
• 格式化<EMISSÃO>为DD.MM.YYYY日期格式
• 格式化<VALOR>为保留两位小数的数值格式
• 固定<TIPO>节点值为SAIDA

完整VBA代码 #

Sub GenerateCorrectXML()
    Dim xmlDoc As Object
    Dim rootNode As Object
    Dim itemNode As Object
    Dim ufNode As Object
    Dim chaveNode As Object
    Dim childNode As Object
    Dim lastRow As Long
    Dim i As Long
    Dim savePath As String
    
    ' 创建XML DOM对象
    Set xmlDoc = CreateObject("MSXML2.DOMDocument")
    xmlDoc.async = False
    xmlDoc.preserveWhiteSpace = True ' 保留格式缩进
    
    ' 创建根节点<Produtos>
    Set rootNode = xmlDoc.createElement("Produtos")
    xmlDoc.appendChild rootNode
    
    ' 获取数据最后一行（假设数据从第2行开始，第1行为表头）
    lastRow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
    
    ' 循环遍历每一行数据
    For i = 2 To lastRow
        ' 创建Item节点，命名为Item_1、Item_2...
        Set itemNode = xmlDoc.createElement("Item_" & (i - 1))
        rootNode.appendChild itemNode
        
        ' 创建<UF>节点并赋值（假设UF在A列）
        Set ufNode = xmlDoc.createElement("UF")
        ufNode.Text = ThisWorkbook.Sheets("Sheet1").Cells(i, "A").Value
        itemNode.appendChild ufNode
        
        ' 创建<CHAVE>节点
        Set chaveNode = xmlDoc.createElement("CHAVE")
        itemNode.appendChild chaveNode
        
        ' 创建<NUMERO>节点（假设NUMERO在B列）
        Set childNode = xmlDoc.createElement("NUMERO")
        childNode.Text = ThisWorkbook.Sheets("Sheet1").Cells(i, "B").Value
        chaveNode.appendChild childNode
        
        ' 创建<EMISSÃO>节点，格式化为DD.MM.YYYY（假设日期在C列）
        Set childNode = xmlDoc.createElement("EMISSÃO")
        If IsDate(ThisWorkbook.Sheets("Sheet1").Cells(i, "C").Value) Then
            childNode.Text = Format(ThisWorkbook.Sheets("Sheet1").Cells(i, "C").Value, "dd.mm.yyyy")
        Else
            childNode.Text = "" ' 空值处理
        End If
        chaveNode.appendChild childNode
        
        ' 创建<CFOP>节点（假设CFOP在D列）
        Set childNode = xmlDoc.createElement("CFOP")
        childNode.Text = ThisWorkbook.Sheets("Sheet1").Cells(i, "D").Value
        chaveNode.appendChild childNode
        
        ' 创建<TIPO>节点，固定值为SAIDA
        Set childNode = xmlDoc.createElement("TIPO")
        childNode.Text = "SAIDA"
        chaveNode.appendChild childNode
        
        ' 创建<VALOR>节点，保留两位小数（假设VALOR在E列）
        Set childNode = xmlDoc.createElement("VALOR")
        If IsNumeric(ThisWorkbook.Sheets("Sheet1").Cells(i, "E").Value) Then
            childNode.Text = Format(ThisWorkbook.Sheets("Sheet1").Cells(i, "E").Value, "0.00")
        Else
            childNode.Text = "0.00" ' 默认空值处理为0.00
        End If
        chaveNode.appendChild childNode
    Next i
    
    ' 设置XML保存路径（可自行修改）
    savePath = ThisWorkbook.Path & "\Produtos.xml"
    
    ' 保存XML文件
    xmlDoc.Save savePath
    
    ' 释放对象
    Set childNode = Nothing
    Set chaveNode = Nothing
    Set ufNode = Nothing
    Set itemNode = Nothing
    Set rootNode = Nothing
    Set xmlDoc = Nothing
    
    MsgBox "XML文件已生成，路径：" & savePath, vbInformation
End Sub

使用说明 #

1. 确保你的数据所在工作表名为Sheet1，若不是需修改代码中ThisWorkbook.Sheets("Sheet1")部分
2. 代码中默认列对应关系：
   • UF → A列
   • NUMERO → B列
   • EMISSÃO → C列
   • CFOP → D列
   • VALOR → E列
     可根据实际数据位置调整代码中Cells(i, "X")的列标识
3. 运行宏后，XML文件会保存在当前Excel文件所在目录下，命名为Produtos.xml

内容的提问来源于stack exchange，提问作者Raí Rodrigues