Question

我构建了一个代码，为每行创建一个.xml文件，例如下面的电子表格

除了 ResetDate 具有相同值且超过1行的一种情况，以下代码都可以正常工作。

VBA代码（我不是专家）

Sub testXLStoXML()
 sTemplateXML = _
        "<?xml version='1.0'?>" + vbNewLine + _
        "<E>" + vbNewLine + _
        "   <ResetDate>" + vbNewLine + _
        "   </ResetDate>" + vbNewLine + _
        "   <ValueDate>" + vbNewLine + _
        "   </ValueDate>" + vbNewLine + _
        "   <MaturityD>" + vbNewLine + _
        "   </MaturityD>" + vbNewLine + _
        "   <Rate>" + vbNewLine + _
        "   </Rate>" + vbNewLine + _
        "   <Quantity>" + vbNewLine + _
        "   </Quantity>" + vbNewLine + _
        "   <ID>" + vbNewLine + _
        "   </ID>" + vbNewLine + _
        "</E>" + vbNewLine

 Set doc = CreateObject("MSXML2.DOMDocument")
 doc.async = False
 doc.validateOnParse = False
 doc.resolveExternals = False

 With ActiveWorkbook.Worksheets(1)
  lLastRow = .UsedRange.Rows.Count

  For lRow = 2 To lLastRow
   sFile = Format(.Cells(lRow, 1).Value, "DD-MMM-YY")
   sBirthdate = Format(.Cells(lRow, 2).Value, "DD-MMM-YY")
   sAmount = Format(.Cells(lRow, 3).Value, "DD-MMM-YY")
   sRate = .Cells(lRow, 4).Value
   sQuantity = .Cells(lRow, 5).Value
   sID = .Cells(lRow, 6).Value
   doc.LoadXML sTemplateXML
   doc.getElementsByTagName("ResetDate")(0).appendChild doc.createTextNode(ResetDate)
   doc.getElementsByTagName("ValueDate")(0).appendChild doc.createTextNode(ValueDate)
   doc.getElementsByTagName("MaturityD")(0).appendChild doc.createTextNode(MaturityD)
  doc.getElementsByTagName("Rate")(0).appendChild doc.createTextNode(sRate)
  doc.getElementsByTagName("Quantity")(0).appendChild doc.createTextNode(sQuantity)
  doc.getElementsByTagName("ID")(0).appendChild doc.createTextNode(sID)
   doc.Save sFile
  Next

 End With
End Sub

如您所见，我得到的日期只有1个文件：

有什么建议吗？预先感谢

Answer 1

删除doc.Save sFile并替换为以下代码：

Dim x as Long
x = Application.CountIf(.Range("A2:A" & lrow), .Cells(lRow, 1))
If  x > 1 Then doc.Save sFile & "_" & x Else doc.Save sFile

因此您修改后的代码为：

Sub testXLStoXML()
Dim x as Long
sTemplateXML = _
    "<?xml version='1.0'?>" + vbNewLine + _
    "<E>" + vbNewLine + _
    "   <ResetDate>" + vbNewLine + _
    "   </ResetDate>" + vbNewLine + _
    "   <ValueDate>" + vbNewLine + _
    "   </ValueDate>" + vbNewLine + _
    "   <MaturityD>" + vbNewLine + _
    "   </MaturityD>" + vbNewLine + _
    "   <Rate>" + vbNewLine + _
    "   </Rate>" + vbNewLine + _
    "   <Quantity>" + vbNewLine + _
    "   </Quantity>" + vbNewLine + _
    "   <ID>" + vbNewLine + _
    "   </ID>" + vbNewLine + _
    "</E>" + vbNewLine

Set doc = CreateObject("MSXML2.DOMDocument")
doc.async = False
doc.validateOnParse = False
doc.resolveExternals = False

With ActiveWorkbook.Worksheets(1)
    lLastRow = .UsedRange.Rows.Count
    For lRow = 2 To lLastRow
        sFile = Format(.Cells(lRow, 1).Value, "DD-MMM-YY")
        sBirthdate = Format(.Cells(lRow, 2).Value, "DD-MMM-YY")
        sAmount = Format(.Cells(lRow, 3).Value, "DD-MMM-YY")
        sRate = .Cells(lRow, 4).Value
        sQuantity = .Cells(lRow, 5).Value
        sID = .Cells(lRow, 6).Value
        doc.LoadXML sTemplateXML
        doc.getElementsByTagName("ResetDate")(0).appendChild doc.createTextNode(ResetDate)
        doc.getElementsByTagName("ValueDate")(0).appendChild doc.createTextNode(ValueDate)
        doc.getElementsByTagName("MaturityD")(0).appendChild doc.createTextNode(MaturityD)
        doc.getElementsByTagName("Rate")(0).appendChild doc.createTextNode(sRate)
        doc.getElementsByTagName("Quantity")(0).appendChild doc.createTextNode(sQuantity)
        doc.getElementsByTagName("ID")(0).appendChild doc.createTextNode(sID)
        x = Application.CountIf(.Range("A2:A" & lrow), .Cells(lRow, 1))
        If  x > 1 Then doc.Save sFile & "_" & x Else doc.Save sFile
    Next lrow
End With

End Sub

Excel：为每行（在电子表格中）创建一个.xml文件（使用VBA）

1 个答案: