Sub ghiExcel_TongHop(ByVal jsonText As String, row As Long, ByVal loaiHD As Long, sSTT As Long)
Dim jsTH As Object, item As Object, itm As Object, subItms As Object, subItms2 As Object, l As Long
Dim ws As Worksheet
Dim arrCol, arrColName
On Error Resume Next
arrCol = Array(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, _
12, 13, 14, 15, 16, 17, 42, 43, 44, _
47, 48, 49, 50, 51, 54)
arrColName = Array("tlhdon", "khmshdon", "khhdon", "shdon", "tdlap", "dvtte", "tgia", "nbten", "nbmst", "nbdchi", _
"nky", "mhdon", "ncma", "nmten", "nmmst", "nmdchi", "tgtcthue", "tgtkcthue", "tgtthue", _
"ttcktmai", "tgtkhac", "tgtttbso", "tgtttbchu", "gchu", "msttcgp")
Select Case loaiHD
Case 1
Set ws = ThisWorkbook.Sheets("TongHopHD_Mua")
Case 2
Set ws = ThisWorkbook.Sheets("TongHopHD_Ban")
End Select
Set jsTH = JsonConverter.ParseJSON(jsonText)
Dim dataArray As Object, i As Long, v As Variant
Set dataArray = jsTH("datas")
For l = 1 To jsTH("datas").count
'On Error Resume Next 'Bo qua cac loi khi khong tim thay cac item trong json,item = null
'/Cot STT
ws.Cells(row, 1).Value = sSTT
For i = 0 To UBound(arrCol)
v = dataArray(l)(arrColName(i))
If v = "" Or IsNull(v) Then GoTo next_col
Select Case arrColName(i)
Case "ncma", "nky", "ncnhat", "ntao", "ntnhan", "tdlap"
ws.Cells(row, arrCol(i)).Value = ISODate(v)
Case Else
ws.Cells(row, arrCol(i)).Value = v
End Select
next_col:
Next i
'/Ghi cac truong dac biet
If Not dataArray(l)("thttltsuat") Is Nothing Then
Set subItms = dataArray(l)("thttltsuat")
If subItms.count > 0 Then
Dim c As Long
For c = 0 To subItms.count - 1 'Có tat ca 6 cot tsuat: KKKCT, KCT, 0%, 5%, 8%, 10%
Set subItms2 = subItms(c + 1)
ws.Cells(row, 18 + (4 * c)).Value = subItms2("tsuat")
ws.Cells(row, 19 + (4 * c)).Value = subItms2("thtien")
ws.Cells(row, 20 + (4 * c)).Value = subItms2("tthue")
ws.Cells(row, 21 + (4 * c)).Value = subItms2("gttsuat")
Next c
End If
End If
If Not IsEmpty(dataArray(l)("thttlphi")) Then
If Not dataArray(l)("thttlphi") Is Nothing Then
Set subItms = dataArray(l)("thttlphi")
If subItms.count > 0 Then
Set subItms2 = subItms(1)
ws.Cells(row, 45).Value = subItms2("tlphi")
ws.Cells(row, 46).Value = subItms2("tphi")
End If
End If
End If
ws.Cells(row, 52).Value = arrTrangThai(CInt(dataArray(l)("tthai")), 1)
ws.Cells(row, 53).Value = arrKQKTHoaDon(CInt(dataArray(l)("ttxly")) + 2, 1)
'------------------------------------------------------------
'/Lay Ma tra cuu + Link tra cuu
'Khai bao cac bien:
Dim Msttcgp As String 'Ma so thue to chuc cap giai phap HDDT
Dim MST As String 'Ma so thue nguoi ban
Dim Mccqt As String 'Ma cap co quan thue
Dim Mtc As String 'Ma tra cuu
Dim Keymtc As String 'Tên truong ma tra cuc
MST = dataArray(l)("nbmst")
Mccqt = ws.Cells(row, 13).Value
'Mtc = ws.Cells(row, 56).Value
'Kiem tra MSTTCGP, khong co thi dung TVANDNKNTT
If Len(dataArray(l)("msttcgp")) > 0 Then
Msttcgp = dataArray(l)("msttcgp")
Else
Msttcgp = dataArray(l)("tvandnkntt") 'Truong hop: Co quan thue nhan khong ma Và Hóa don tu máy tính tien
ws.Cells(row, 54).Value = Msttcgp
End If
'Lay thong tin truong tra cuu chinh xac cua Nguoi ban hoac To chuc giai phap
If Len(Tracuuma("", MST)) > 0 Then
Keymtc = Tracuuma("", MST)
ElseIf Len(Tracuuma(Msttcgp, MST)) > 0 Then
Keymtc = Tracuuma(Msttcgp, MST)
ElseIf Len(Tracuuma(Msttcgp, "")) > 0 Then
Keymtc = Tracuuma(Msttcgp, "")
Else
Keymtc = ""
End If
ws.Cells(row, 58).Value = Keymtc 'Ghi ra cot BE de kiem tra key dung voi MST nguoi ban, hoac MST TCGP chua
'ws.Cells(row, 57).Value = "Không có MTC" 'Khong co MTC
'------------------------------------------------------------
'/Lay Ma tra cuu
'Lay thong tin tai truong: cttkhac
If Not dataArray(l)("cttkhac") Is Nothing Then
Set subItms = dataArray(l)("cttkhac")
For Each itm In subItms
'TH tim theo key cho truoc
If Len(Keymtc) > 0 Then
If itm("ttruong") = Keymtc And dicTenCotTC.Exists(Keymtc) Then
ws.Cells(row, 56).Value = itm("dlieu")
ws.Cells(row, 57).Value = "True" 'Dung key theo MST
Exit For
End If
Mtc = ws.Cells(row, 56).Value
If Len(Mtc) = 0 Then
If dicTenCotTC.Exists(itm("ttruong")) Then
ws.Cells(row, 56).Value = itm("dlieu")
ws.Cells(row, 58).Value = itm("ttruong")
ws.Cells(row, 57).Value = "Sai Fkey" 'MST co truong tra cuu nhung không dung
Exit For
End If
End If
Else 'TH tim theo toan bo list
ws.Cells(row, 57).Value = "False"
If dicTenCotTC.Exists(itm("ttruong")) Then
ws.Cells(row, 56).Value = itm("dlieu")
ws.Cells(row, 58).Value = itm("ttruong")
ws.Cells(row, 57).Value = "Update Fkey" 'MST khong co truong tra cuu ma
Exit For
End If
End If
Next
End If
'Lay thong tin tai truong: ttkhac
If Not dataArray(l)("ttkhac") Is Nothing Then
Set subItms = dataArray(l)("ttkhac")
For Each itm In subItms
'TH tim theo key cho truoc
If Len(Keymtc) > 0 Then
If itm("ttruong") = Keymtc And dicTenCotTC.Exists(Keymtc) Then
ws.Cells(row, 56).Value = itm("dlieu")
ws.Cells(row, 57).Value = "True" 'Dung key theo MST
Exit For
End If
Mtc = ws.Cells(row, 56).Value
If Len(Mtc) = 0 Then
If dicTenCotTC.Exists(itm("ttruong")) Then
ws.Cells(row, 56).Value = itm("dlieu")
ws.Cells(row, 58).Value = itm("ttruong")
ws.Cells(row, 57).Value = "Sai Fkey" 'MST co truong tra cuu nhung không dung
Exit For
End If
End If
Else 'TH tim theo toan bo list
ws.Cells(row, 57).Value = "False"
If dicTenCotTC.Exists(itm("ttruong")) Then
ws.Cells(row, 56).Value = itm("dlieu")
ws.Cells(row, 58).Value = itm("ttruong")
ws.Cells(row, 57).Value = "Update Fkey" 'MST khong co truong tra cuu ma
Exit For
End If
End If
Next
End If
'------------------------------------------------------------
'/Lay link tra cuu
Mtc = ws.Cells(row, 56).Value
'Các truong hop dac biet
Select Case Msttcgp
Case "0100150619" 'BIDV
ws.Cells(row, 55).Value = Tracuulink(Msttcgp, "") & dataArray(l)("Fkey")
'Truong hop ghep Link xem truc tiep Hoa don: Misa, Icrop, Fast, Vetc, Thái Son, Cyber, Visnam
Case "0101243150", "0106870211", "0100727825", "0107500414", "0101300842", "0105232093", "0401486901"
ws.Cells(row, 55).Value = Tracuulink(Msttcgp, "") & Mtc
Case "0100684378" 'VNPT
If Len(Mtc) > 5 Then 'Có ma tra cuu
If Len(Mtc) = 10 And Right(Mtc, 1) = "*" Then 'Hóa don Petrolimex
ws.Cells(row, 55).Value = "https://hoadon.petrolimex.com.vn/SearchInvoicebycode/?strFkey=" & Mtc
Else
If Len(Tracuulink("", MST)) > 0 Then 'Truong hop ten mien tuy bien
ws.Cells(row, 55).Value = Tracuulink("", MST) & Mtc
Else 'Truong hop ten mien theo Mst
ws.Cells(row, 55).Value = "https://" & MST & "-tt78.vnpt-invoice.com.vn/?strFkey=" & Mtc
End If
End If
Else 'Không có ma tra cuu
If Len(Tracuulink("", MST)) > 0 Then 'Truong hop ten mien tuy bien theo MST
If Len(Mccqt) > 0 Then 'Có ma co quan thue
ws.Cells(row, 55).Value = Tracuulink("", MST) & Mccqt
Else 'Khong co ma co quan thue
ws.Cells(row, 55).Value = Tracuulink("", MST) & "<Tai file XML lay ma tra cuu truong Fkey>"
End If
Else 'Truong hop ten mien theo Mst
If Len(Mccqt) > 0 Then 'Có ma co quan thue
ws.Cells(row, 55).Value = "https://" & MST & "-tt78.vnpt-invoice.com.vn/?strFkey=" & Mccqt
Else 'Khong co ma co quan thue
ws.Cells(row, 55).Value = "https://" & MST & "-tt78.vnpt-invoice.com.vn/?strFkey=" & "<Tai file XML lay ma tra cuu truong Fkey>"
End If
End If
End If
Case "0105987432" 'Easy
ws.Cells(row, 55).Value = "https://" & MST & "hd.easyinvoice.com.vn/Search/?Fkey=" & Mtc & " Hoac: https://" & MST & "hd.easyinvoice.vn/Search/?Fkey=" & Mtc
Case "0106026495" 'M-INVOICE
ws.Cells(row, 55).Value = "https://tracuuhoadon.minvoice.com.vn/api/Search/SearchInvoice?type=PDF&masothue=" & MST & "&sobaomat=" & Mtc
Case "0101360697" 'BKAV
If Len(Mccqt) > 0 Then
ws.Cells(row, 55).Value = "https://van.ehoadon.vn/Lookup?InvoiceGUID=" & """<ID cua file XML>"""
'ws.Cells(row, 56).Value = "Lay <DLHDon ID> cua file XML"
Else
ws.Cells(row, 55).Value = "Không có Link"
End If
Case Else 'Cac truong hop con lai
If Len(Tracuulink("", MST)) > 0 Then
ws.Cells(row, 55).Value = Tracuulink("", MST)
Else
If Len(Tracuulink(Msttcgp, MST)) > 0 Then
ws.Cells(row, 55).Value = Tracuulink(Msttcgp, MST)
Else
ws.Cells(row, 55).Value = Tracuulink(Msttcgp, "")
End If
End If
End Select
'------------------------------------------------------------------/
'Tang so tt va so thu thu dong
sSTT = sSTT + 1
row = row + 1
next_invoice:
Next l
End Sub
.
). Rất cảm ơn 
