Option Explicit
Sub TaoPLGT()
Const Col_ThueSuat As String = "X"
Const Col_ThanhTien As String = "Z"
Const Col_TenHHDV As String = "R"
Const Col_TenNguoiBan As String = "F"
Const Col_NgayHD As String = "C"
Const Col_SoHD As String = "B"
Const Col_SoHD_TongHop As String = "E"
Const Col_KetQua_TongHop As String = "BA"
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim wsDest As Worksheet
Dim arrMua As Variant, arrBan As Variant
Dim rStart As Long, colIdx As Integer, rHeader2 As Long
Dim sheetNameDest As String: sheetNameDest = "BK01_GT_GTGT_NQ142"
arrMua = GetFilteredData("ChiTietHD_Mua", True, Col_ThueSuat, Col_ThanhTien, Col_TenHHDV, Col_TenNguoiBan, Col_NgayHD, Col_SoHD)
arrBan = GetFilteredData("ChiTietHD_Ban", False, Col_ThueSuat, Col_ThanhTien, Col_TenHHDV, "", "", "")
If Not IsArray(arrMua) And Not IsArray(arrBan) Then
MsgBox "Không tìm th?y d? li?u thu? 8% (ho?c các giá tr? d?u b?ng 0)!", vbExclamation
GoTo CleanUp
End If
If IsArray(arrMua) Then
Dim wsTH As Worksheet
Dim dictKQ As Object
Dim lastRowTH As Long
Dim arrSoHD_TH As Variant, arrKQ_TH As Variant
Dim i As Long, soHD As String
On Error Resume Next
Set wsTH = ThisWorkbook.Sheets("TongHopHD_Mua")
On Error GoTo 0
If Not wsTH Is Nothing Then
Set dictKQ = CreateObject("Scripting.Dictionary")
dictKQ.CompareMode = 1
lastRowTH = wsTH.Cells(wsTH.Rows.count, Col_SoHD_TongHop).End(xlUp).row
If lastRowTH >= 2 Then
arrSoHD_TH = wsTH.Range(Col_SoHD_TongHop & "1:" & Col_SoHD_TongHop & lastRowTH).Value
arrKQ_TH = wsTH.Range(Col_KetQua_TongHop & "1:" & Col_KetQua_TongHop & lastRowTH).Value
For i = 2 To lastRowTH
If Not IsEmpty(arrSoHD_TH(i, 1)) Then
dictKQ(CStr(arrSoHD_TH(i, 1))) = arrKQ_TH(i, 1)
End If
Next i
For i = 1 To UBound(arrMua, 1)
soHD = CStr(arrMua(i, 7))
If dictKQ.Exists(soHD) Then
arrMua(i, 8) = dictKQ(soHD)
End If
Next i
End If
End If
End If
On Error Resume Next
Set wsDest = ThisWorkbook.Sheets(sheetNameDest)
On Error GoTo 0
If wsDest Is Nothing Then
Set wsDest = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count))
wsDest.name = sheetNameDest
Else
wsDest.Cells.Clear
End If
wsDest.Range("1:22").EntireRow.Hidden = True
wsDest.Cells.Font.name = "Arial"
wsDest.Cells.Font.size = 10
rStart = 25
wsDest.Cells(rStart, 2).Value = _
"I. H" & ChrW(224) & "ng h" & ChrW(243) & "a, d" & ChrW(7883) & "ch v" & ChrW(7909) & _
" mua v" & ChrW(224) & "o trong k" & ChrW(7923) & " " & ChrW(273) & ChrW(432) & ChrW(7907) & _
"c " & ChrW(225) & "p d" & ChrW(7909) & "ng m" & ChrW(7913) & "c thu" & ChrW(7871) & _
" su" & ChrW(7845) & "t thu" & ChrW(7871) & " gi" & ChrW(225) & " tr" & ChrW(7883) & _
" gia t" & ChrW(259) & "ng 8% (" & ChrW(225) & "p d" & ChrW(7909) & "ng cho ng" & _
ChrW(432) & ChrW(7901) & "i n" & ChrW(7897) & "p thu" & ChrW(7871) & " k" & ChrW(234) & _
" khai theo ph" & ChrW(432) & ChrW(417) & "ng ph" & ChrW(225) & "p kh" & _
ChrW(7845) & "u tr" & ChrW(7915) & " thu" & ChrW(7871) & ")"
wsDest.Cells(rStart, 2).Font.Bold = True
Dim hMua As Variant
hMua = Array( _
"STT", _
"T" & ChrW(234) & "n h" & ChrW(224) & "ng h" & ChrW(243) & "a, d" & ChrW(7883) & "ch v" & ChrW(7909), _
"Gi" & ChrW(225) & " tr" & ChrW(7883) & " h" & ChrW(224) & "ng h" & ChrW(243) & "a, d" & ChrW(7883) & "ch v" & ChrW(7909) & " mua v" & ChrW(224) & "o ch" & ChrW(432) & "a c" & ChrW(243) & " thu" & ChrW(7871) & " GTGT " & ChrW(273) & ChrW(432) & ChrW(7907) & "c kh" & ChrW(7845) & "u tr" & ChrW(7915) & " trong k" & ChrW(7923), _
"Thu" & ChrW(7871) & " GTGT c" & ChrW(7911) & "a h" & ChrW(224) & "ng h" & ChrW(243) & "a, d" & ChrW(7883) & "ch v" & ChrW(7909) & " mua v" & ChrW(224) & "o " & ChrW(273) & ChrW(432) & ChrW(7907) & "c kh" & ChrW(7845) & "u tr" & ChrW(7915) & " trong k" & ChrW(7923), _
"T" & ChrW(234) & "n ng" & ChrW(432) & ChrW(7901) & "i b" & ChrW(225) & "n", _
"Ng" & ChrW(224) & "y l" & ChrW(7853) & "p h" & ChrW(243) & "a " & ChrW(273) & ChrW(417) & "n", _
"S" & ChrW(7889) & " h" & ChrW(243) & "a " & ChrW(273) & ChrW(417) & "n", _
"K" & ChrW(7871) & "t qu" & ChrW(7843) & " ki" & ChrW(7875) & "m tra h" & ChrW(243) & "a " & ChrW(273) & ChrW(417) & "n" _
)
wsDest.Range(wsDest.Cells(26, 2), wsDest.Cells(26, 9)).Value = hMua
For colIdx = 2 To 9
wsDest.Range(wsDest.Cells(26, colIdx), wsDest.Cells(28, colIdx)).Merge
Next colIdx
wsDest.Range(wsDest.Cells(29, 2), wsDest.Cells(29, 9)).Value = Array("'(1)", "'(2)", "'(3)", "'(4)", "A", "B", "C", "D")
Call FormatHeaders(wsDest.Range(wsDest.Cells(26, 2), wsDest.Cells(29, 9)))
wsDest.Range(wsDest.Cells(26, 6), wsDest.Cells(29, 9)).Interior.Color = vbYellow
If IsArray(arrMua) Then
rStart = 30
wsDest.Range(wsDest.Cells(rStart, 2), wsDest.Cells(rStart + UBound(arrMua, 1) - 1, 9)).Value = arrMua
Call FormatDataBody(wsDest.Range(wsDest.Cells(rStart, 2), wsDest.Cells(rStart + UBound(arrMua, 1) - 1, 9)), 8)
rStart = rStart + UBound(arrMua, 1)
Else
rStart = 30
End If
rStart = rStart + 1
wsDest.Cells(rStart, 2).Value = "II. H" & ChrW(224) & "ng h" & ChrW(243) & "a, d" & ChrW(7883) & "ch v" & ChrW(7909) & " b" & ChrW(225) & "n ra trong k" & ChrW(7923)
wsDest.Cells(rStart, 2).Font.Bold = True
rHeader2 = rStart + 1
Dim hBan As Variant
hBan = Array( _
"STT", _
"T" & ChrW(234) & "n h" & ChrW(224) & "ng h" & ChrW(243) & "a, d" & ChrW(7883) & "ch v" & ChrW(7909), _
"Gi" & ChrW(225) & " tr" & ChrW(7883) & " h" & ChrW(224) & "ng h" & ChrW(243) & "a, d" & ChrW(7883) & "ch v" & ChrW(7909) & " ch" & ChrW(432) & "a c" & ChrW(243) & " thu" & ChrW(7871) & " GTGT", _
"Thu" & ChrW(7871) & " su" & ChrW(7845) & "t thu" & ChrW(7871) & " GTGT theo quy " & ChrW(273) & ChrW(7883) & "nh", _
"Thu" & ChrW(7871) & " su" & ChrW(7845) & "t thu" & ChrW(7871) & " GTGT sau gi" & ChrW(7843) & "m", _
"Thu" & ChrW(7871) & " GTGT c" & ChrW(7911) & "a h" & ChrW(224) & "ng h" & ChrW(243) & "a, d" & ChrW(7883) & "ch v" & ChrW(7909) & " b" & ChrW(225) & "n ra " & ChrW(273) & ChrW(432) & ChrW(7907) & "c gi" & ChrW(7843) & "m" _
)
wsDest.Range(wsDest.Cells(rHeader2, 2), wsDest.Cells(rHeader2, 7)).Value = hBan
For colIdx = 2 To 7
wsDest.Range(wsDest.Cells(rHeader2, colIdx), wsDest.Cells(rHeader2 + 2, colIdx)).Merge
Next colIdx
wsDest.Range(wsDest.Cells(rHeader2 + 3, 2), wsDest.Cells(rHeader2 + 3, 7)).Value = Array("'(1)", "'(2)", "'(3)", "'(4)", "(5)=(4)x80%", "(6)=(3)x[(4)-(5)]")
Call FormatHeaders(wsDest.Range(wsDest.Cells(rHeader2, 2), wsDest.Cells(rHeader2 + 3, 7)))
rStart = rHeader2 + 4
If IsArray(arrBan) Then
wsDest.Range(wsDest.Cells(rStart, 2), wsDest.Cells(rStart + UBound(arrBan, 1) - 1, 7)).Value = arrBan
Call FormatDataBody(wsDest.Range(wsDest.Cells(rStart, 2), wsDest.Cells(rStart + UBound(arrBan, 1) - 1, 7)), 6)
End If
wsDest.Columns(1).ColumnWidth = 3 ' C?t A tr?ng bên ngoài
wsDest.Columns(2).ColumnWidth = 5 ' STT (B)
wsDest.Columns(3).ColumnWidth = 40 ' Tên HHDV (C)
wsDest.Columns(4).ColumnWidth = 18 ' Giá tr? (D)
wsDest.Columns(5).ColumnWidth = 18 ' Ti?n thu? (E)
wsDest.Columns(6).ColumnWidth = 25 ' Tên ngu?i bán (F)
wsDest.Columns(7).ColumnWidth = 15 ' Ngày l?p (G)
wsDest.Columns(8).ColumnWidth = 15 ' S? HÐ (H)
wsDest.Columns(9).ColumnWidth = 20 ' KQ Ki?m tra (I)
CleanUp:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
If IsArray(arrMua) Or IsArray(arrBan) Then
MsgBox "Da tai xong Phu Luc thanh cong!", vbInformation, "Hoan tat"
Sheets("BK01_GT_GTGT_NQ142").Select
End If
End Sub
Private Function GetFilteredData(sheetName As String, isMua As Boolean, _
cThue As String, cTien As String, cTen As String, _
cNban As String, cNgay As String, cSo As String) As Variant
Dim ws As Worksheet
Dim lastRow As Long, i As Long, r As Long
Dim arrSrc As Variant, arrDest As Variant
Dim valThue As Variant, valTien As Variant
On Error Resume Next
Set ws = ThisWorkbook.Sheets(sheetName)
On Error GoTo 0
If ws Is Nothing Then Exit Function
lastRow = ws.Cells(ws.Rows.count, cThue).End(xlUp).row
If lastRow < 2 Then Exit Function
arrSrc = ws.Range("A1:CZ" & lastRow).Value
Dim iThue As Integer, iTien As Integer, iTen As Integer
Dim iNban As Integer, iNgay As Integer, iSo As Integer
iThue = ws.Range(cThue & 1).Column
iTien = ws.Range(cTien & 1).Column
iTen = ws.Range(cTen & 1).Column
If isMua Then
iNban = ws.Range(cNban & 1).Column
iNgay = ws.Range(cNgay & 1).Column
iSo = ws.Range(cSo & 1).Column
End If
Dim cols As Integer
If isMua Then cols = 8 Else cols = 6
ReDim arrDest(1 To lastRow, 1 To cols)
r = 0
For i = 2 To lastRow
valThue = arrSrc(i, iThue)
If Not IsError(valThue) And Not IsEmpty(valThue) Then
If CStr(valThue) Like "*8%*" Or valThue = 8 Or valThue = 0.08 Or CStr(valThue) = "8" Then
valTien = arrSrc(i, iTien)
If Not IsNumeric(valTien) Or IsEmpty(valTien) Then valTien = 0
If CDbl(valTien) <> 0 Then
r = r + 1
arrDest(r, 1) = r
arrDest(r, 2) = arrSrc(i, iTen)
arrDest(r, 3) = Round(CDbl(valTien), 0)
If isMua Then
arrDest(r, 4) = Round(CDbl(valTien) * 0.08, 0)
arrDest(r, 5) = arrSrc(i, iNban)
arrDest(r, 6) = arrSrc(i, iNgay)
arrDest(r, 7) = arrSrc(i, iSo)
arrDest(r, 8) = ""
Else
arrDest(r, 4) = ""
arrDest(r, 5) = ""
arrDest(r, 6) = ""
End If
End If
End If
End If
Next i
If r > 0 Then
Dim arrFinal As Variant
ReDim arrFinal(1 To r, 1 To cols)
Dim rIdx As Long, cIdx As Integer
For rIdx = 1 To r
For cIdx = 1 To cols
arrFinal(rIdx, cIdx) = arrDest(rIdx, cIdx)
Next cIdx
Next rIdx
GetFilteredData = arrFinal
End If
End Function
Private Sub FormatHeaders(rng As Range)
With rng
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Interior.Color = RGB(204, 255, 204)
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
End With
End Sub
Private Sub FormatDataBody(rng As Range, cols As Integer)
With rng
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.VerticalAlignment = xlCenter
End With
rng.Columns(1).HorizontalAlignment = xlCenter
rng.Columns(3).NumberFormat = "#,##0"
If cols = 8 Then
rng.Columns(4).NumberFormat = "#,##0"
rng.Columns(6).NumberFormat = "dd/mm/yyyy"
End If
End Sub
.
Đúng là nhầm thật. Mà cái hoá đơn của Mobifone đúng là không tìm ra được mã tra cứu (từ các file json, xml của web), chỉ có được từ file pdf hoá đơn gốc.
