Cách gán dữ liệu lặp qua từng nhân viên và Transpose theo chiều dọc vào sheet EXPORT

Liên hệ QC
bigbabol89

bigbabol89

Thành viên thường trực
Tham gia
15/10/12
Bài viết
224
Được thích
34
Chào các anh chị,
Mong các anh chị giúp đỡ em vấn đề sau ạ :
Em muốn chuyển format dữ liệu ở sheet “01-TNCN” giống như sheet “EXPORT”
  • Dữ liệu ( không tô màu ) chuyển có định dạng kiểu xml : <>ct08dữ liệu</ct08> (ct08 là tiêu đề chạy theo cột, ở hàng 22)
  • Phần bôi vàng là phần cố định, chỉ thay đổi 1 số dữ liệu như tên công ty, số tệp, ngày tạo tệp,…( em có note bên cạnh ).
  • Phần tô màu xanh có format hơi khác biệt chút, em cũng không biết có nguyên tắc gì.
Em cám ơn ạ
 

File đính kèm

  • FILE MẪU.xlsx
    492.5 KB · Đọc: 23
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
bigbabol89 đã viết:
Cám ơn anh nhé. Công thức rất hay ạ.
Tuy nhiên nếu em dùng công thức và làm khoảng 100 người thì sẽ hơi khó khăn ạ.
Anh có thể giúp em dùng macro được không ạ ?
Nhấp chuột vào đây để mở rộng...
Không, vì tôi bỏ VBA lâu rồi, nên giờ chắc không bằng người mới tập...
Nếu biết thì cứ viết code đi có gì chém được tôi chém, còn tự viết giờ đại lãm lắm ...
 
Upvote 0
Nếu bạn muốn tạo tập tin XML trên đĩa thì ...

Tôi làm chơi thử. Code sẽ tạo tập tin file.xml trong cùng thư mục với tập tin Excel chứa code.

Cách làm: mở tập tin Excel và lưu ở dạng XLSM -> Alt + F11 -> menu Insert -> Module -> dán code sau vào module vừa chèn.

Chạy code createXML
Mã: 
Option Explicit

Private Function appendChild(xmldoc As Object, parentNode As Object, ByVal nodename As String, ByVal nodetext As String, ByVal settext As Boolean) As Object
Dim node As Object
    Set node = xmldoc.createElement(nodename)
    If settext Then node.text = nodetext
    If Not parentNode Is Nothing Then parentNode.appendChild node
    Set appendChild = node
End Function

Sub createXML()
Dim lastRow As Long, r As Long, c As Long, text As String, data(), sh As Worksheet, xmldoc As Object
Dim rootNode As Object, ktNode As Object, tcNode As Object, node As Object, parentNode As Object, childNode As Object
    Set sh = ThisWorkbook.Worksheets("01-TNCN")
    With sh
        lastRow = .Range("C22:C10000").Find("*", .Range("C22"), xlFormulas, xlPart, xlByRows, xlPrevious).Row
        If lastRow < 22 Then Exit Sub
        data = .Range("A22:AJ" & lastRow).Value
    End With
   
    Set xmldoc = CreateObject("MSXML2.DOMDocument")
    xmldoc.appendChild xmldoc.CreateProcessingInstruction("xml", "version=""1.0"" encoding=""utf-8""")
   
    Set rootNode = xmldoc.createElement("HSoThueDTu")
    rootNode.setAttribute "xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance"
    rootNode.setAttribute "xmlns", "http://kekhaithue.gdt.gov.vn/TKhaiThue"
    xmldoc.appendChild rootNode
   
    Set ktNode = appendChild(xmldoc, rootNode, "HSoKhaiThue", "", False)

    Set tcNode = appendChild(xmldoc, ktNode, "TTinChung", "", False)
   
    Set node = appendChild(xmldoc, tcNode, "TTinDVu", "", False)
    appendChild xmldoc, node, "maDVu", "QTT", True
    text = "C" & ChrW(244) & "ng c" & ChrW(7909) & " h" & ChrW(7895) & " tr" & ChrW(7907) & " k" & ChrW(234) & " khai QTT"
    appendChild xmldoc, node, "tenDVu", text, True
    appendChild xmldoc, node, "pbanDVu", "3.3.0", True
    appendChild xmldoc, node, "ttinNhaCCapDVu", "", False
   
    Set node = appendChild(xmldoc, tcNode, "TCtrathunhap", "", False)
    appendChild xmldoc, node, "maTKhai", "999", True
    text = "T" & ChrW(7900) & " KHAI " & ChrW(272) & ChrW(258) & "NG K" & ChrW(221) & _
            " THU" & ChrW(7870) & " THU NH" & ChrW(7852) & "P C" & ChrW(193) & " NH" & ChrW(194) & "N"
    appendChild xmldoc, node, "tenTKhai", text, True
    appendChild xmldoc, node, "moTaBMau", "", False
    appendChild xmldoc, node, "pbanTKhaiXML", "1.1.0", True
    appendChild xmldoc, node, "mst", sh.Range("E8").Value, True
    appendChild xmldoc, node, "ten", sh.Range("E10").Value, True
    appendChild xmldoc, node, "maCQTQuanLy", "10100", True
    text = "V" & ChrW(259) & "n ph" & ChrW(242) & "ng C" & ChrW(7909) & "c thu" & ChrW(7871) & " Th" & _
                ChrW(224) & "nh Ph" & ChrW(7889) & " H" & ChrW(224) & " N" & ChrW(7897) & "i"
    appendChild xmldoc, node, "tenCQTQuanLy", text, True
    appendChild xmldoc, node, "sohieutep", sh.Range("E16").Value, True
    appendChild xmldoc, node, "ngayTao", sh.Range("E18").Value, True
    appendChild xmldoc, node, "soluong", sh.Range("L18").Value, True
   
    Set node = appendChild(xmldoc, ktNode, "CTieuTKhaiChinh", "", False)
   
    For r = 2 To UBound(data)
        Set parentNode = appendChild(xmldoc, node, "DSachCNDangkyMST", "", False)
        parentNode.setAttribute "id", """" & data(r, 1) & """"
        For c = 2 To UBound(data, 2)
            If c < 16 Or c > 31 Then
                If c = 2 Or c = 14 Then
                    Set childNode = appendChild(xmldoc, parentNode, data(1, c), "", False)
                    childNode.setAttribute "xsi:nil", """true"""
                Else
                    Set childNode = appendChild(xmldoc, parentNode, data(1, c), data(r, c), True)
                End If
            Else
                If c = 16 Then
                    Set childNode = appendChild(xmldoc, parentNode, "DChokhau", "", False)
                ElseIf c = 25 Then
                    Set childNode = appendChild(xmldoc, parentNode, "DCcutru", "", False)
                End If
                appendChild xmldoc, childNode, data(1, c), data(r, c), True
            End If
        Next c
    Next r
   
    xmldoc.Save ThisWorkbook.Path & "/file.xml"
    Set xmldoc = Nothing
End Sub
 
Upvote 0
batman1 đã viết:
Nếu bạn muốn tạo tập tin XML trên đĩa thì ...

Tôi làm chơi thử. Code sẽ tạo tập tin file.xml trong cùng thư mục với tập tin Excel chứa code.

Cách làm: mở tập tin Excel và lưu ở dạng XLSM -> Alt + F11 -> menu Insert -> Module -> dán code sau vào module vừa chèn.

Chạy code createXML
Mã: 
Option Explicit

Private Function appendChild(xmldoc As Object, parentNode As Object, ByVal nodename As String, ByVal nodetext As String, ByVal settext As Boolean) As Object
Dim node As Object
    Set node = xmldoc.createElement(nodename)
    If settext Then node.text = nodetext
    If Not parentNode Is Nothing Then parentNode.appendChild node
    Set appendChild = node
End Function

Sub createXML()
Dim lastRow As Long, r As Long, c As Long, text As String, data(), sh As Worksheet, xmldoc As Object
Dim rootNode As Object, ktNode As Object, tcNode As Object, node As Object, parentNode As Object, childNode As Object
    Set sh = ThisWorkbook.Worksheets("01-TNCN")
    With sh
        lastRow = .Range("C22:C10000").Find("*", .Range("C22"), xlFormulas, xlPart, xlByRows, xlPrevious).Row
        If lastRow < 22 Then Exit Sub
        data = .Range("A22:AJ" & lastRow).Value
    End With
 
    Set xmldoc = CreateObject("MSXML2.DOMDocument")
    xmldoc.appendChild xmldoc.CreateProcessingInstruction("xml", "version=""1.0"" encoding=""utf-8""")
 
    Set rootNode = xmldoc.createElement("HSoThueDTu")
    rootNode.setAttribute "xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance"
    rootNode.setAttribute "xmlns", "http://kekhaithue.gdt.gov.vn/TKhaiThue"
    xmldoc.appendChild rootNode
 
    Set ktNode = appendChild(xmldoc, rootNode, "HSoKhaiThue", "", False)

    Set tcNode = appendChild(xmldoc, ktNode, "TTinChung", "", False)
 
    Set node = appendChild(xmldoc, tcNode, "TTinDVu", "", False)
    appendChild xmldoc, node, "maDVu", "QTT", True
    text = "C" & ChrW(244) & "ng c" & ChrW(7909) & " h" & ChrW(7895) & " tr" & ChrW(7907) & " k" & ChrW(234) & " khai QTT"
    appendChild xmldoc, node, "tenDVu", text, True
    appendChild xmldoc, node, "pbanDVu", "3.3.0", True
    appendChild xmldoc, node, "ttinNhaCCapDVu", "", False
 
    Set node = appendChild(xmldoc, tcNode, "TCtrathunhap", "", False)
    appendChild xmldoc, node, "maTKhai", "999", True
    text = "T" & ChrW(7900) & " KHAI " & ChrW(272) & ChrW(258) & "NG K" & ChrW(221) & _
            " THU" & ChrW(7870) & " THU NH" & ChrW(7852) & "P C" & ChrW(193) & " NH" & ChrW(194) & "N"
    appendChild xmldoc, node, "tenTKhai", text, True
    appendChild xmldoc, node, "moTaBMau", "", False
    appendChild xmldoc, node, "pbanTKhaiXML", "1.1.0", True
    appendChild xmldoc, node, "mst", sh.Range("E8").Value, True
    appendChild xmldoc, node, "ten", sh.Range("E10").Value, True
    appendChild xmldoc, node, "maCQTQuanLy", "10100", True
    text = "V" & ChrW(259) & "n ph" & ChrW(242) & "ng C" & ChrW(7909) & "c thu" & ChrW(7871) & " Th" & _
                ChrW(224) & "nh Ph" & ChrW(7889) & " H" & ChrW(224) & " N" & ChrW(7897) & "i"
    appendChild xmldoc, node, "tenCQTQuanLy", text, True
    appendChild xmldoc, node, "sohieutep", sh.Range("E16").Value, True
    appendChild xmldoc, node, "ngayTao", sh.Range("E18").Value, True
    appendChild xmldoc, node, "soluong", sh.Range("L18").Value, True
 
    Set node = appendChild(xmldoc, ktNode, "CTieuTKhaiChinh", "", False)
 
    For r = 2 To UBound(data)
        Set parentNode = appendChild(xmldoc, node, "DSachCNDangkyMST", "", False)
        parentNode.setAttribute "id", """" & data(r, 1) & """"
        For c = 2 To UBound(data, 2)
            If c < 16 Or c > 31 Then
                If c = 2 Or c = 14 Then
                    Set childNode = appendChild(xmldoc, parentNode, data(1, c), "", False)
                    childNode.setAttribute "xsi:nil", """true"""
                Else
                    Set childNode = appendChild(xmldoc, parentNode, data(1, c), data(r, c), True)
                End If
            Else
                If c = 16 Then
                    Set childNode = appendChild(xmldoc, parentNode, "DChokhau", "", False)
                ElseIf c = 25 Then
                    Set childNode = appendChild(xmldoc, parentNode, "DCcutru", "", False)
                End If
                appendChild xmldoc, childNode, data(1, c), data(r, c), True
            End If
        Next c
    Next r
 
    xmldoc.Save ThisWorkbook.Path & "/file.xml"
    Set xmldoc = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Cái này hay lắm anh ạ !. Để em thử theo cách này với các File khác
 
Upvote 0
batman1 đã viết:
Nếu bạn muốn tạo tập tin XML trên đĩa thì ...

Tôi làm chơi thử. Code sẽ tạo tập tin file.xml trong cùng thư mục với tập tin Excel chứa code.

Cách làm: mở tập tin Excel và lưu ở dạng XLSM -> Alt + F11 -> menu Insert -> Module -> dán code sau vào module vừa chèn.

Chạy code createXML
Mã: 
Option Explicit

Private Function appendChild(xmldoc As Object, parentNode As Object, ByVal nodename As String, ByVal nodetext As String, ByVal settext As Boolean) As Object
Dim node As Object
    Set node = xmldoc.createElement(nodename)
    If settext Then node.text = nodetext
    If Not parentNode Is Nothing Then parentNode.appendChild node
    Set appendChild = node
End Function

Sub createXML()
Dim lastRow As Long, r As Long, c As Long, text As String, data(), sh As Worksheet, xmldoc As Object
Dim rootNode As Object, ktNode As Object, tcNode As Object, node As Object, parentNode As Object, childNode As Object
    Set sh = ThisWorkbook.Worksheets("01-TNCN")
    With sh
        lastRow = .Range("C22:C10000").Find("*", .Range("C22"), xlFormulas, xlPart, xlByRows, xlPrevious).Row
        If lastRow < 22 Then Exit Sub
        data = .Range("A22:AJ" & lastRow).Value
    End With
  
    Set xmldoc = CreateObject("MSXML2.DOMDocument")
    xmldoc.appendChild xmldoc.CreateProcessingInstruction("xml", "version=""1.0"" encoding=""utf-8""")
  
    Set rootNode = xmldoc.createElement("HSoThueDTu")
    rootNode.setAttribute "xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance"
    rootNode.setAttribute "xmlns", "http://kekhaithue.gdt.gov.vn/TKhaiThue"
    xmldoc.appendChild rootNode
  
    Set ktNode = appendChild(xmldoc, rootNode, "HSoKhaiThue", "", False)

    Set tcNode = appendChild(xmldoc, ktNode, "TTinChung", "", False)
  
    Set node = appendChild(xmldoc, tcNode, "TTinDVu", "", False)
    appendChild xmldoc, node, "maDVu", "QTT", True
    text = "C" & ChrW(244) & "ng c" & ChrW(7909) & " h" & ChrW(7895) & " tr" & ChrW(7907) & " k" & ChrW(234) & " khai QTT"
    appendChild xmldoc, node, "tenDVu", text, True
    appendChild xmldoc, node, "pbanDVu", "3.3.0", True
    appendChild xmldoc, node, "ttinNhaCCapDVu", "", False
  
    Set node = appendChild(xmldoc, tcNode, "TCtrathunhap", "", False)
    appendChild xmldoc, node, "maTKhai", "999", True
    text = "T" & ChrW(7900) & " KHAI " & ChrW(272) & ChrW(258) & "NG K" & ChrW(221) & _
            " THU" & ChrW(7870) & " THU NH" & ChrW(7852) & "P C" & ChrW(193) & " NH" & ChrW(194) & "N"
    appendChild xmldoc, node, "tenTKhai", text, True
    appendChild xmldoc, node, "moTaBMau", "", False
    appendChild xmldoc, node, "pbanTKhaiXML", "1.1.0", True
    appendChild xmldoc, node, "mst", sh.Range("E8").Value, True
    appendChild xmldoc, node, "ten", sh.Range("E10").Value, True
    appendChild xmldoc, node, "maCQTQuanLy", "10100", True
    text = "V" & ChrW(259) & "n ph" & ChrW(242) & "ng C" & ChrW(7909) & "c thu" & ChrW(7871) & " Th" & _
                ChrW(224) & "nh Ph" & ChrW(7889) & " H" & ChrW(224) & " N" & ChrW(7897) & "i"
    appendChild xmldoc, node, "tenCQTQuanLy", text, True
    appendChild xmldoc, node, "sohieutep", sh.Range("E16").Value, True
    appendChild xmldoc, node, "ngayTao", sh.Range("E18").Value, True
    appendChild xmldoc, node, "soluong", sh.Range("L18").Value, True
  
    Set node = appendChild(xmldoc, ktNode, "CTieuTKhaiChinh", "", False)
  
    For r = 2 To UBound(data)
        Set parentNode = appendChild(xmldoc, node, "DSachCNDangkyMST", "", False)
        parentNode.setAttribute "id", """" & data(r, 1) & """"
        For c = 2 To UBound(data, 2)
            If c < 16 Or c > 31 Then
                If c = 2 Or c = 14 Then
                    Set childNode = appendChild(xmldoc, parentNode, data(1, c), "", False)
                    childNode.setAttribute "xsi:nil", """true"""
                Else
                    Set childNode = appendChild(xmldoc, parentNode, data(1, c), data(r, c), True)
                End If
            Else
                If c = 16 Then
                    Set childNode = appendChild(xmldoc, parentNode, "DChokhau", "", False)
                ElseIf c = 25 Then
                    Set childNode = appendChild(xmldoc, parentNode, "DCcutru", "", False)
                End If
                appendChild xmldoc, childNode, data(1, c), data(r, c), True
            End If
        Next c
    Next r
  
    xmldoc.Save ThisWorkbook.Path & "/file.xml"
    Set xmldoc = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Anh ơi, xịn quá. Hi hi...
Nhưng anh có thể sửa giúp em những cột có định dạng ngày tháng thì ở file xml thì sẽ theo định dạng là "yyyy-mm-dd" được không ạ ?
Vì file xml nó không cho phép định dạng kiểu mm/dd/yyyy.
Em cám ơn.
 
Upvote 0
bigbabol89 đã viết:
Anh ơi, xịn quá. Hi hi...
Nhưng anh có thể sửa giúp em những cột có định dạng ngày tháng thì ở file xml thì sẽ theo định dạng là "yyyy-mm-dd" được không ạ ?
Vì file xml nó không cho phép định dạng kiểu mm/dd/yyyy.
Em cám ơn.
Nhấp chuột vào đây để mở rộng...
Thay dòng
Mã: 
appendChild xmldoc, node, "ngayTao", sh.Range("E18").Value, True

bằng

Mã: 
appendChild xmldoc, node, "ngayTao", Format(sh.Range("E18").Value, "yyyy-mm-dd"), True

Trong cụm For c = 2 To UBound(data, 2) ... Next c tìm
Mã: 
Set childNode = appendChild(xmldoc, parentNode, data(1, c), data(r, c), True)

và đổi thành

Mã: 
If c = 4 Or c = 10 Or c = 34 Then
    value_ = Format(data(r, c), "yyyy-mm-dd")
Else
    value_ = data(r, c)
End If
Set childNode = appendChild(xmldoc, parentNode, data(1, c), value_, True)
 
Upvote 0
batman1 đã viết:
Thay dòng
Mã: 
appendChild xmldoc, node, "ngayTao", sh.Range("E18").Value, True

bằng

Mã: 
appendChild xmldoc, node, "ngayTao", Format(sh.Range("E18").Value, "yyyy-mm-dd"), True

Trong cụm For c = 2 To UBound(data, 2) ... Next c tìm
Mã: 
Set childNode = appendChild(xmldoc, parentNode, data(1, c), data(r, c), True)

và đổi thành

Mã: 
If c = 4 Or c = 10 Or c = 34 Then
    value_ = Format(data(r, c), "yyyy-mm-dd")
Else
    value_ = data(r, c)
End If
Set childNode = appendChild(xmldoc, parentNode, data(1, c), value_, True)
Nhấp chuột vào đây để mở rộng...
Em cám ơn anh nhé.
 
Upvote 0
Cho em hỏi thêm với cách thức này chuyển ngược lại từ xml ra bản excel với file đã làm ở trên thì sẽ làm thành thế nào anh nhỉ ?
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

C
Giúp em viết công thức làm lịch thi đấu.
Trả lời
5
Đọc
89
SA_DQ
SA_DQ
HuynhThiMinhPhung
nối dữ liệu từ nhiều worksheet
Trả lời
1
Đọc
2
BuiQuangThuan
B
T
Hỏi về các tính tổng của một số theo thể thức tam giác pascal
Trả lời
9
Đọc
5K
Xphuonc
Xphuonc
LuuAnh980
Filter lọc có "mm" mà không thấy.
Trả lời
4
Đọc
94
LuuAnh980
LuuAnh980
H
Trích Lọc dữ liệu với Macro
Trả lời
18
Đọc
1K
HTN033
H
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom