Chuyển đổi từ XML sang Excel

Chia sẻ bởi:hands

★★★★★

‹ Lấy dữ liệu từ file xml bằng... Tìm phần mềm (Free) chuyển file .xml... ›

Quảng cáo

Trong quá trình làm việc em có được gửi dữ liệu dạng Xml. Tuy Nhiên em muốn chuyển đổi từ XmL sang excel dạng bảng để tiện theo dõi các dữ liệu này. Anh ( Chị) cho em hỏi cách Viết VBa của phần chuyển từ xml sang excel sẽ dùng Từ điển nào trong VBA để làm và Cách thức tổng quát của phần này ( Dạng các Function để có thể thao tác nhanh hơn khi chuyển đổi các file này sang excel ). Trong file đính kèm em có lấy ví dụ mẫu về việc chuyển đổi File tỷ giá vàng dạng xml và File excel kết quả mong muốn. Anh ( chị ) hướng dẫn em với ạ. Em Cảm ơn các anh (chị) ạ !

Microsoft hỗ trợ import xml thì cứ thế xài thôi, chế tác làm gì cho mất công

Dạ vâng ạ, để em thử với file này xem sao. Em cảm ơn Anh ạ !

Viết theo file xml đính kèm của bạn

Public Sub GPE()
Dim Fso As Object, ObjFile As Object, TextS As Object, TLines, Citi  As String
Dim sArr, Item, K As Long, I As Long, Str As String
ReDim sArr(1 To 10000, 1 To 4)

Set Fso = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False

With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
    .Filters.Add "Txt Files", "*.xml", 1
    If Not .Show = -1 Then
        MsgBox "Ban chua chon File", vbInformation, "----Mr.GPE----"
        Exit Sub
    End If
'On Error Resume Next
For Each Item In .SelectedItems
    Set TextS = Fso.OpenTextFile(Item, 1, , -2)
        TLines = Split(TextS.ReadAll, vbCrLf)
        For I = LBound(TLines) To UBound(TLines)
        Str = TLines(I)

If Left(Str, 10) = "<city name" Then
            Citi = Mid(TLines(I), 13, Len(TLines(I)) - 14)
        End If

If Left(Str, 10) = "<item buy=" Then
                K = K + 1
                sArr(K, 1) = Citi
                sArr(K, 2) = Mid(TLines(I), 12, 6)
                sArr(K, 3) = Mid(TLines(I), 26, 6)
                sArr(K, 4) = Mid(TLines(I), 40, Len(TLines(I)) - 42)
            End If
        Next

Next
End With

If K Then
    Range("A1").CurrentRegion.Offset(1).ClearContents
    Range("A2").Resize(K, 4).Value = sArr
End If
MsgBox "Done!"
Application.ScreenUpdating = True
End Sub