Thứ Sáu, 8 tháng 1, 2021

Sub tính toán số liệu bảng cân đối số phát sinh TK Cấp I

Sub SO_CAN_DOI_SO_PSCAPI_NEW()
On Error Resume Next
THANG_LV = NT.Range("OTLV_NT").Value
NAM_LV = NT.Range("ONLV_NT").Value
Dim SHLTNKC As Worksheet
Set SHLTNKC = Sheets("LTNKC")
Dim SH1 As Worksheet
Set SH1 = Sheets("CANDOIPHATSINH")
SH1.Select
Dim MyArrayLOCIN()
Dim MyArraycode()
Dim MyArrayMAGHEPNO()
Dim MyArrayMAGHEPCO()
Dim MyArraySOTIEN()
Dim MyArrayPSNO()
Dim MyArrayPSCO()
Dim MyArraySODUDAUKYNO()
Dim MyArraySODUDAUKYCO()
Dim MyArraySODUDAUKYGHISO()
Dim MyArraySODUCUOIKYNO()
Dim MyArraySODUCUOIKYCO()
Dim MyArraySODUCUOIKYGHISO()
Dim MyArrayATKCAPI()
Dim MyArrayBTKCAPI()
HSCONGPSDK = 0
HSCONGPSDKNO = 0
HSCONGPSDKCO = 0
HSCONGPSCK = 0
HSCONGPSCKNO = 0
HSCONGPSCKCO = 0
HSCONGPSNO = 0
HSCONGPSCO = 0
IPS_MKH = 0
HSIPS_SCT = 0
HSIPS_KH = 0
SH1.Select
SH1.Range("I" & HSDONGDAUCDPS - 1 & ":" & "I" & HSDONGCUOICDPS).Select
SH1.Range("I" & HSDONGDAUCDPS - 1 & ":" & "I" & HSDONGCUOICDPS).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
DK.Range("DK1_DK"), Unique:=False
ActiveSheet.ShowAllData
i_next = 0
For i = HSR_DNKC + 1 To HSR_CNKC - 1
If Month(NKC.Range("B" & i).Value) - HSTHANGDAU < 0 Then
i_next = i_next + 1
ReDim Preserve MyArrayMAGHEPNO(i_next - 1)
ReDim Preserve MyArrayMAGHEPCO(i_next - 1)
ReDim Preserve MyArraySOTIEN(i_next - 1)
For I1 = HSR_DTKCAPI + 1 To HSR_CTKCAPI - 1
If Left(NKC.Range("F" & i).Value, Len(TKCAPI.Range("A" & I1).Value)) = TKCAPI.Range("A" & I1).Value Then
MyArrayMAGHEPNO(i_next - 1) = TKCAPI.Range("A" & I1).Value & "DKN" End If
If Left(NKC.Range("H" & i).Value, Len(TKCAPI.Range("A" & I1).Value)) = TKCAPI.Range("A" & I1).Value Then
MyArrayMAGHEPCO(i_next - 1) = TKCAPI.Range("A" & I1).Value & "DKC" End If
Next
MyArraySOTIEN(i_next - 1) = NKC.Range("J" & i).Value
Else
If Month(NKC.Range("B" & i).Value) - HSTHANGDAU >= 0 And _
Month(NKC.Range("B" & i).Value) - HSTHANGCUOI <= 0 Then
i_next = i_next + 1
ReDim Preserve MyArrayMAGHEPNO(i_next - 1)
ReDim Preserve MyArrayMAGHEPCO(i_next - 1)
ReDim Preserve MyArraySOTIEN(i_next - 1)
For I1 = HSR_DTKCAPI + 1 To HSR_CTKCAPI - 1
If Left(NKC.Range("F" & i).Value, Len(TKCAPI.Range("A" & I1).Value)) = TKCAPI.Range("A" & I1).Value Then
MyArrayMAGHEPNO(i_next - 1) = TKCAPI.Range("A" & I1).Value & "PSN"
End If
If Left(NKC.Range("H" & i).Value, Len(TKCAPI.Range("A" & I1).Value)) = TKCAPI.Range("A" & I1).Value Then
MyArrayMAGHEPCO(i_next - 1) = TKCAPI.Range("A" & I1).Value & "PSC"
End If
Next
MyArraySOTIEN(i_next - 1) = NKC.Range("J" & i).Value
HSIPS_SCT = HSIPS_SCT + 1
ReDim Preserve HSMyArrayINDEXSCT(HSIPS_SCT - 1)
HSMyArrayINDEXSCT(HSIPS_SCT - 1) = i - (HSR_DNKC - 1)
End If
End If
Next
SHLTNKC.Range("A1" & ":" & "A" & 1 + i_next - 1) _
= WorksheetFunction.Transpose(MyArrayMAGHEPNO)
SHLTNKC.Range("B1" & ":" & "B" & 1 + i_next - 1) _
= WorksheetFunction.Transpose(MyArrayMAGHEPCO)
SHLTNKC.Range("C1" & ":" & "C" & 1 + i_next - 1) _
= WorksheetFunction.Transpose(MyArraySOTIEN)
Set MAGHEPNO = SHLTNKC.Range("A1" & ":" & "A" & 1 + i_next - 1)
Set MAGHEPCO = SHLTNKC.Range("B1" & ":" & "B" & 1 + i_next - 1)
Set DONGSOTIEN = SHLTNKC.Range("C1" & ":" & "C" & 1 + i_next - 1)
'TINH SO DU DAU KY
For i = HSR_DTKCAPI + 1 To HSR_CTKCAPI - 1
SODUDAUKY = 0
PSNO = 0
PSCO = 0
PSNOPS = 0
PSCOPS = 0
If TKCAPI.Range("A" & i).Value <> "" Then
IPS_MKH = IPS_MKH + 1
ReDim Preserve MyArrayATKCAPI(IPS_MKH - 1)
ReDim Preserve MyArrayBTKCAPI(IPS_MKH - 1)
ReDim Preserve MyArraycode(IPS_MKH - 1)
MyArrayATKCAPI(IPS_MKH - 1) = TKCAPI.Range("B" & i).Value
MyArrayBTKCAPI(IPS_MKH - 1) = TKCAPI.Range("A" & i).Value
MyArraycode(IPS_MKH - 1) = "'" & TKCAPI.Range("C" & i).Value
MAGHEP = TKCAPI.Range("A" & i).Value
For I_SDDK = HSR_DSDTKDK + 1 To HSR_CSDTKDK
If Left(SDTKDK.Range("B" & I_SDDK).Value, Len(MAGHEP)) = MAGHEP Then
SODUDAUKY = SODUDAUKY + SDTKDK.Range("F" & I_SDDK).Value
End If
Next
TRIDONO = TKCAPI.Range("A" & i).Value & "DKN"
TRIDOCO = TKCAPI.Range("A" & i).Value & "DKC"
TRIDONOPS = TKCAPI.Range("A" & i).Value & "PSN"
TRIDOCOPS = TKCAPI.Range("A" & i).Value & "PSC"
PSNO = Application.WorksheetFunction.SumIf(MAGHEPNO, TRIDONO, DONGSOTIEN)
PSCO = Application.WorksheetFunction.SumIf(MAGHEPCO, TRIDOCO, DONGSOTIEN)
PSNOPS = Application.WorksheetFunction.SumIf(MAGHEPNO, TRIDONOPS, DONGSOTIEN)
PSCOPS = Application.WorksheetFunction.SumIf(MAGHEPCO, TRIDOCOPS, DONGSOTIEN)
SODUDAUKY = SODUDAUKY + PSNO - PSCO
HSCONGPSDK = HSCONGPSDK + SODUDAUKY
ReDim Preserve MyArraySODUDAUKYNO(IPS_MKH - 1)
ReDim Preserve MyArraySODUDAUKYCO(IPS_MKH - 1)
ReDim Preserve MyArrayPSNO(IPS_MKH - 1)
ReDim Preserve MyArrayPSCO(IPS_MKH - 1)
ReDim Preserve MyArraySODUCUOIKYNO(IPS_MKH - 1)
ReDim Preserve MyArraySODUCUOIKYCO(IPS_MKH - 1)
ReDim Preserve MyArraySODUDAUKYGHISO(IPS_MKH - 1)
ReDim Preserve MyArraySODUCUOIKYGHISO(IPS_MKH - 1)
ReDim Preserve MyArrayLOCIN(IPS_MKH - 1)
If Left(TKCAPI.Range("A" & i).Value, 3) = "129" _
Or Left(TKCAPI.Range("A" & i).Value, 3) = "139" _
Or Left(TKCAPI.Range("A" & i).Value, 3) = "159" _
Or Left(TKCAPI.Range("A" & i).Value, 3) = "214" _
Or Left(TKCAPI.Range("A" & i).Value, 3) = "229" Then
MyArraySODUDAUKYCO(IPS_MKH - 1) = -1 * SODUDAUKY
MyArraySODUCUOIKYCO(IPS_MKH - 1) = -1 * (SODUDAUKY + PSNOPS - PSCOPS)
HSCONGPSDKCO = HSCONGPSDKCO + SODUDAUKY
HSCONGPSCKCO = HSCONGPSCKCO + (SODUDAUKY + PSNOPS - PSCOPS)
Else
If Left(TKCAPI.Range("A" & i).Value, 1) = "1" _
Or Left(TKCAPI.Range("A" & i).Value, 1) = "2" Then
MyArraySODUDAUKYNO(IPS_MKH - 1) = SODUDAUKY
MyArraySODUCUOIKYNO(IPS_MKH - 1) = (SODUDAUKY + PSNOPS - PSCOPS)
HSCONGPSDKNO = HSCONGPSDKNO + SODUDAUKY
HSCONGPSCKNO = HSCONGPSCKNO + (SODUDAUKY + PSNOPS - PSCOPS)
Else
If Left(TKCAPI.Range("A" & i).Value, 1) = "3" _
Or Left(TKCAPI.Range("A" & i).Value, 1) = "4" Then
MyArraySODUDAUKYCO(IPS_MKH - 1) = -1 * SODUDAUKY
MyArraySODUCUOIKYCO(IPS_MKH - 1) = -1 * (SODUDAUKY + PSNOPS - PSCOPS)
HSCONGPSDKCO = HSCONGPSDKCO + SODUDAUKY
HSCONGPSCKCO = HSCONGPSCKCO + (SODUDAUKY + PSNOPS - PSCOPS)
Else
If Left(TKCAPI.Range("A" & i).Value, 3) = "001" _
Or Left(TKCAPI.Range("A" & i).Value, 3) = "002" _
Or Left(TKCAPI.Range("A" & i).Value, 3) = "003" _
Or Left(TKCAPI.Range("A" & i).Value, 3) = "004" _
Or Left(TKCAPI.Range("A" & i).Value, 3) = "005" _
Or Left(TKCAPI.Range("A" & i).Value, 3) = "006" _
Or Left(TKCAPI.Range("A" & i).Value, 3) = "007" _
Or Left(TKCAPI.Range("A" & i).Value, 3) = "008" _
Or Left(TKCAPI.Range("A" & i).Value, 3) = "009" _
Then
MyArraySODUDAUKYNO(IPS_MKH - 1) = ""
MyArraySODUDAUKYCO(IPS_MKH - 1) = ""
MyArraySODUCUOIKYNO(IPS_MKH - 1) = ""
MyArraySODUCUOIKYCO(IPS_MKH - 1) = ""
Else
If SODUDAUKY > 0 Then
MyArraySODUDAUKYNO(IPS_MKH - 1) = SODUDAUKY
HSCONGPSDKNO = HSCONGPSDKNO + SODUDAUKY
Else
MyArraySODUDAUKYCO(IPS_MKH - 1) = -1 * SODUDAUKY
HSCONGPSDKCO = HSCONGPSDKCO + SODUDAUKY
End If
If (SODUDAUKY + PSNOPS - PSCOPS) > 0 Then
MyArraySODUCUOIKYNO(IPS_MKH - 1) = (SODUDAUKY + PSNOPS - PSCOPS)
HSCONGPSCKNO = HSCONGPSCKNO + (SODUDAUKY + PSNOPS - PSCOPS)
Else
MyArraySODUCUOIKYCO(IPS_MKH - 1) = -1 * (SODUDAUKY + PSNOPS - PSCOPS)
HSCONGPSCKCO = HSCONGPSCKCO + (SODUDAUKY + PSNOPS - PSCOPS)
End If
End If
End If
End If
End If
MyArraySODUDAUKYGHISO(IPS_MKH - 1) = SODUDAUKY
MyArraySODUCUOIKYGHISO(IPS_MKH - 1) = (SODUDAUKY + PSNOPS - PSCOPS)
MyArrayPSNO(IPS_MKH - 1) = PSNOPS
MyArrayPSCO(IPS_MKH - 1) = PSCOPS
HSCONGPSCK = HSCONGPSCK + SODUDAUKY + PSNOPS - PSCOPS
HSCONGPSNO = HSCONGPSNO + PSNOPS
HSCONGPSCO = HSCONGPSCO + PSCOPS
If SODUDAUKY <> 0 Or PSNOPS <> 0 Or PSCOPS <> 0 Then
HSIPS_KH = HSIPS_KH + 1
MyArrayLOCIN(IPS_MKH - 1) = 1
ReDim Preserve HSMyArraySODUDAUKYSCT(IPS_MKH - 1)
ReDim Preserve HSMyArrayPSNOSCT(IPS_MKH - 1)
ReDim Preserve HSMyArrayPSCOSCT(IPS_MKH - 1)
ReDim Preserve HSMyArraySODUCUOIKYSCT(IPS_MKH - 1)
Else
MyArrayLOCIN(IPS_MKH - 1) = 0
End If
End If
Next
SH1.Range("A" & HSDONGDAUCDPS + 1 & ":" & "A" & HSDONGDAUCDPS + 1 + IPS_MKH - 1) _
= WorksheetFunction.Transpose(MyArrayATKCAPI)
SH1.Range("B" & HSDONGDAUCDPS + 1 & ":" & "B" & HSDONGDAUCDPS + 1 + IPS_MKH - 1) _
= WorksheetFunction.Transpose(MyArrayBTKCAPI)
SH1.Range("C" & HSDONGDAUCDPS + 1 & ":" & "C" & HSDONGDAUCDPS + 1 + IPS_MKH - 1) _
= WorksheetFunction.Transpose(MyArraySODUDAUKYNO)
SH1.Range("D" & HSDONGDAUCDPS + 1 & ":" & "D" & HSDONGDAUCDPS + 1 + IPS_MKH - 1) _
= WorksheetFunction.Transpose(MyArraySODUDAUKYCO)
SH1.Range("E" & HSDONGDAUCDPS + 1 & ":" & "E" & HSDONGDAUCDPS + 1 + IPS_MKH - 1) _
= WorksheetFunction.Transpose(MyArrayPSNO)
SH1.Range("F" & HSDONGDAUCDPS + 1 & ":" & "F" & HSDONGDAUCDPS + 1 + IPS_MKH - 1) _
= WorksheetFunction.Transpose(MyArrayPSCO)
SH1.Range("G" & HSDONGDAUCDPS + 1 & ":" & "G" & HSDONGDAUCDPS + 1 + IPS_MKH - 1) _
= WorksheetFunction.Transpose(MyArraySODUCUOIKYNO)
SH1.Range("H" & HSDONGDAUCDPS + 1 & ":" & "H" & HSDONGDAUCDPS + 1 + IPS_MKH - 1) _
= WorksheetFunction.Transpose(MyArraySODUCUOIKYCO)
SH1.Range("I" & HSDONGDAUCDPS + 1 & ":" & "I" & HSDONGDAUCDPS + 1 + IPS_MKH - 1) _
= WorksheetFunction.Transpose(MyArrayLOCIN)
SH1.Range("J" & HSDONGDAUCDPS + 1 & ":" & "J" & HSDONGDAUCDPS + 1 + IPS_MKH - 1) _
= WorksheetFunction.Transpose(MyArraySODUDAUKYGHISO)
SH1.Range("K" & HSDONGDAUCDPS + 1 & ":" & "K" & HSDONGDAUCDPS + 1 + IPS_MKH - 1) _
= WorksheetFunction.Transpose(MyArraySODUCUOIKYGHISO)
SH1.Range("L" & HSDONGDAUCDPS + 1 & ":" & "L" & HSDONGDAUCDPS + 1 + IPS_MKH - 1) _
= WorksheetFunction.Transpose(MyArraycode)
SH1.Range("C" & HSDONGCUOICDPS + 1).Value = HSCONGPSDKNO
SH1.Range("D" & HSDONGCUOICDPS + 1).Value = -1 * HSCONGPSDKCO
SH1.Range("E" & HSDONGCUOICDPS + 1).Value = HSCONGPSNO
SH1.Range("F" & HSDONGCUOICDPS + 1).Value = HSCONGPSCO
SH1.Range("G" & HSDONGCUOICDPS + 1).Value = HSCONGPSCKNO
SH1.Range("H" & HSDONGCUOICDPS + 1).Value = -1 * HSCONGPSCKCO
If HSTHANGDAU = HSTHANGCUOI Then
SH1.Range("D44").Value = Right("0" & HSTHANGDAU, 2)
Else
SH1.Range("C44").Value = "TÖØ THAÙNG : " & Right("0" & HSTHANGDAU, 2) & " ÑEÁN THAÙNG : " & Right("0" & HSTHANGCUOI, 2)
SH1.Range("C44:C45").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
SH1.Range("D45").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End If
SH1.Range("D45").Value = NAM_LV
'TRICH LOC
SH1.Range("I" & HSDONGDAUCDPS - 1 & ":" & "IV" & HSDONGCUOICDPS).Select
Selection.AutoFilter Field:=1, Criteria1:="1"
End Sub
Previous Post
Next Post

0 nhận xét: