如何使用VBA自动将Excel中的指定数据范围转换为XML

14 浏览
0 Comments

如何使用VBA自动将Excel中的指定数据范围转换为XML

我需要自动化选择数据范围的过程。

目前,用户通过输入框提示输入数据范围,并创建一个包含该数据的XML文件,但我需要脚本从Excel表格中获取数据范围,该范围在一个单元格中指定Excel表格示例

最终,XML文件应该如下所示:




5555.555 
333.333 
22.22 


1.111 
2.222 
4.4444444 


444.44 
333.333 
9.999 


当前脚本代码:

Sub CreateXMLFile()
    Const THE_FOLDER As String = "C:\"
    Dim ws As Worksheet, rngData As Range, fName As String, rw As Long, col As Long
    Dim xml As String, tagId As String, tagVal As String, v
    fName = "C:\EDS\xml1.xml"
    On Error Resume Next
    Set rngData = Application.InputBox("2. 输入数据范围(包括标题):", _
                                       "CreateXMLFile", Type:=8)
    On Error Resume Next
    If rngData Is Nothing Then
        Debug.Print "未指定范围"
        Exit Sub
    End If
    Open fName For Output As #1
    Print #1, ""
    Print #1, ""
    For rw = 2 To rngData.Rows.Count
        tagId = rngData.Cells(rw, 1).Value
        Print #1, "<" & tagId & ">"
        For col = 2 To rngData.Columns.Count
            tagVal = rngData.Cells(1, col).Value
            v = rngData.Cells(rw, col).Value
            Print #1, "<" & tagVal & ">" & Replace(CheckForm(v), "&", "+") & ""
        Next col
        Print #1, ""
    Next rw
    Print #1, ""
    Open fName For Output As #1
    Close #1
    MsgBox fName & " 已创建。" & vbLf & "完成", vbOKOnly + vbInformation, "CreateXMLFile"
    Debug.Print fName & " 已保存。"
End Sub
Function CheckForm(v) As String
    If IsNumeric(v) Then v = Format(v, "#.######## ;(0.########)")
    CheckForm = CStr(v)
End Function

我尝试将A1单元格的范围存入字符串变量,然后存入rngData,但只给我一个空的XML文件:




我也尝试使用Range(),但一直收到错误。

非常感谢您的帮助!

0
0 Comments

问题的原因是想要在VBA中自动从Excel中获取指定范围的数据并转换为XML格式。解决方法是使用Range.Value(xlRangeValueXMLSpreadsheet)方法将Excel数据直接转换为XML格式,并使用XSLT转换将数据以所需的形式保存为XML文件。

代码示例:

Sub Value12()
Const fname As String = "Test12.xml"
Dim t As Double: t = Timer
'1) define data range
    Dim rng As Range
    Set rng = Sheet1.Range("A2:D5")
'2) load basic xml data
    Dim xDoc   As New MSXML2.DOMDocument60
    xDoc.LoadXML xmlContent(rng)
'3) load xml style sheet containing specific transfer syntax
    Dim xslDoc As New MSXML2.DOMDocument60
    xslDoc.LoadXML xslContent(rng)
'4) transfer to wanted data structure via xslt
    xDoc.transformNodeToObject xslDoc, xDoc
'5) save xml to file
    xDoc.Save ThisWorkbook.Path & "\" & fname
    MsgBox fname & " created " & vbLf & "in " & Format(Timer - t, "0.00 secs."), vbOKOnly + vbInformation, "Create XML File (T.M.)"
    Debug.Print xDoc.XML
End Sub

Function xmlContent(rng As Range) As String
'Purp.: change range values to specific xml structure via .Value(12)
    Dim content As String
    content = rng.Value(12)
    content = Replace(content, ":", "")
    xmlContent = content
End Function

Function xslContent(rng As Range) As String
'Purp.: get wellformed xsl content string
'a) define basic content pattern
    Dim arr(0 To 15)
    arr(0) = ""
    arr(1) = "  "
    arr(2) = "  "
    arr(3) = ""
    arr(4) = ""
    arr(5) = "  "
    arr(6) = "     "
    arr(7) = "        "
    arr(8) = "           "
    arr(9) = "           "
    arr(10) = "           "
    arr(11) = "        "
    arr(12) = "    "
    arr(13) = "  "
    arr(14) = ""
    arr(15) = ""
'b) define header variables
    Dim hdr: hdr = Application.Transpose(Application.Transpose(rng.Rows(1).Value2))
    Dim i As Long
    For i = 1 To UBound(hdr) - 1
        hdr(i) = "" & Trim(hdr(i + 1)) & ""
    Next
    ReDim Preserve hdr(1 To UBound(hdr) - 1)
'c) insert header variables
    arr(3) = Join(hdr, vbNullString)
'd) return xsl content
    xslContent = Join(arr, vbNewLine)
End Function

这种方法可以直接将Excel中的表格数据转换为XML格式,并通过XSLT转换将数据保存为XML文件。这样可以避免使用循环和纯字符串拼接的方式处理数据,提高了处理效率。

0
0 Comments

在VBA中,如果要从Excel自动获取指定范围的数据并转换为XML格式,可以考虑使用XML APIs的全面W3C兼容库MSXML。可以使用DOM方法(createElement,appendChild,setAttribute)构建XML,而不是将文本字符串连接起来。

首先,需要在VBA中引用MSXML库,可以使用早期或晚期绑定。然后可以根据以下示例从Excel数据中迭代构建一个树结构。此外,MSXML支持XSLT 1.0,这是用于转换XML文件的专用语言。下面的代码运行“身份转换”以美化输出,并在每行和缩进上换行显示。否则,所有内容将在一行上显示。

另外,让用户输入包括工作表名称的完整绝对范围路径(例如,Sheet1!A1:Z50)。

下面是XSLT代码(保存为.xsl,一个特殊的.xml文件,可以在VBA中读取):


  
  
  
  
    
      
    
  

以下是VBA代码:

Sub xmlExport()
On Error GoTo ErrHandle
    ' VBA REFERENCE MSXML, v6.0
    Dim doc As MSXML2.DOMDocument60, xslDoc As MSXML2.DOMDocument60, newDoc As MSXML2.DOMDocument60
    Dim rootNode As IXMLDOMElement, tagNode As IXMLDOMElement, chTagNode As IXMLDOMElement
    Dim rngData As Range
    Dim fName  As String, chTagVal As String
    Dim rw As Long, col As Long
    fName = "C:\EDS\xml1.xml"
    Set rngData = Application.InputBox( _
        Prompt := "2. Enter the sheet range of data (Including Headers) (e.g., Sheet1!A1:Z50):", _
        Title := "CreateXMLFile", _
        Type := 8 _
    )
    ' INITIALIZE XML DOC
    Set doc = New MSXML2.DOMDocument60
    ' APPEND ROOT NODE
    Set rootNode = doc.createElement("DeclarationFile")
    doc.appendChild rootNode
    ' ITERATE THROUGH RANGE
    For rw = 2 To rngData.Rows.Count
        ' APPEND TAG TO ROOT
        Set tagNode = doc.createElement(rngData.Cells(rw, 1).Value)
        rootNode.appendChild tagNode
        For col = 2 To rngData.Columns.Count
            ' APPEND CHILD TAG
            Set chTagNode = doc.createElement(rngData.Cells(1, col).Value)
            tagNode.appendChild chTagNode
            ' ADD TEXT VALUE
            chTagVal = rngData.Cells(rw, col).Value
            chTagNode.Text = Replace(CheckForm(chTagVal), "&", "+")
        Next col
    Next rw
    ' INITIALIZE XSL DOC
    Set xslDoc = New MSXML2.DOMDocument60
    Set newDoc = New MSXML2.DOMDocument60
    ' LOAD XSLT AND TRANSFORM
    xslDoc.Load "C:\Path\To\Script.xsl"
    xslDoc.async = False
    doc.transformNodeToObject xslDoc, newDoc
    ' SAVE XML TO FILE
    newDoc.Save fName
    MsgBox fName & " created." & vbLf & "Done", vbOKOnly + vbInformation, "CreateXMLFile"
    Debug.Print fName & " saved."
ExitHandle:
    Set rngData = Nothing
    Set rootNode = Nothing: Set tagNode = Nothing: Set chTagNode = Nothing
    Set doc = Nothing: Set xslDoc = Nothing: Set newDoc = Nothing
    Exit Sub
ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbCritical
    Resume ExitHandle
End Sub
Function CheckForm(v) As String
    If IsNumeric(v) Then v = Format(v, "#.######## ;(0.########)")
    CheckForm = CStr(v)
End Function

以上就是自动从Excel中获取指定范围的数据并转换为XML的方法。

0
0 Comments

问题的出现原因:在使用VBA自动将Excel中指定范围的数据导出到XML时,需要使用Range方法来指定范围,但是在使用Range方法时,需要明确指定所在的工作表,否则会出现错误。

解决方法:通过使用Range方法中的Sheets属性来明确指定所在的工作表,从而解决了获取指定范围数据的问题。

下面是解决该问题的代码示例:

Set rngData = Sheets("Sheet1").Range(Sheets("Sheet1").Range("A1"))

这段代码中,通过Sheets("Sheet1")来明确指定所在的工作表,然后再使用Range方法来指定具体的范围,从而正确地获取到了需要导出的数据。

感谢使用Range方法,并指定所在工作表的方法,解决了问题。对于VBA新手来说,可能不了解需要明确指定工作表,因此在使用VBA时需要注意这一点。

0