Dim soctgoc As Range, phieuthu As Range, ngayct As Range, ngayht As Range
Dim noidung As Range, matkno As Range, matkco As Range, tienvn As Range
'soctgoc (cot 1), phieuthu (cot 2), ngayct (cot 3), ngayht (cot 4)
'noidung (cot 5), matkno (cot 6), matkco (cot 7), tienvn (cot 8)
Dim WF As WorksheetFunction
Dim data As Range
Dim iR As Long, DongDau As Long, i As Long, j As Long, SoT As Long
Dim Th_PS As Long, NgayDau As Date, NgayCuoi As Date
Dim SoTienPSTruoc As Double
Sub TaoNKC()
DongDau = 10
With Application
.ScreenUpdating = False: .DisplayAlerts = False: .Calculation = xlCalculationManual
End With
Set WF = WorksheetFunction
Sheet1.Select
'Tim dong cuoi cua data theo cot soctgoc (1)'
With Sheet2
iR = .Cells(65000, 1).End(xlUp).Row
'data co 19 cot'
Set data = .Range(.Cells(1, 1), .Cells(iR, 19))
Set ngayht = .Range("E2:E" & iR) 'cot ngayht la cot 5 trong data'
Set tienvn = .Range("Q2:Q" & iR) 'cot tienvn la cot 17 trong data'
End With
'Lay du lieu theo thang '
Th_PS = Range("E5") 'Gan ngay dau va ngay cuoi -> AF'
NgayDau = DateSerial(2008, Th_PS, 1)
NgayCuoi = DateSerial(2008, Th_PS + 1, 0)
'Tinh so phat sinh cac ky truoc
SoTienPSTruoc = WF.SumIf(ngayht, "<" & CLng(NgayDau), tienvn)
Set ngayht = Nothing
Set tienvn = Nothing
With Sheet5
.Range("K2") = ">=" & NgayDau
.Range("L2") = "<=" & NgayCuoi
End With
With Sheet5
.Range("A2:I65000").ClearContents
data.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
.Range("K1:L2"), CopyToRange:=.Range("A1:H1"), Unique:=False
iR = .Cells(65000, 1).End(xlUp).Row
Set data = .Range(.Cells(2, 1), .Cells(iR, 8))
With data 'sort lai theo ngayht, soctgoc, matkno'
.Sort Key1:=.Range("D2"), Order1:=xlAscending, Key2:=.Range("A2") _
, Order2:=xlAscending, Key3:=.Range("F2"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal
End With
End With
ActiveWorkbook.Names("Criteria").Delete
ActiveWorkbook.Names("Extract").Delete
Range("H9") = SoTienPSTruoc
Range("I9") = SoTienPSTruoc
Range("A" & DongDau & ":J10000").ClearContents
Range("A" & DongDau & ":J10000").Font.Bold = False
Range("A" & DongDau & ":J10000").Select
XoaKhung
'Cong doan chuyen sang NKC'
With Sheet5 'xem lai phan nay chuyen sang offset
Set soctgoc = data.Offset(0, 0).Resize(, 1)
Set matkno = data.Offset(0, 5).Resize(, 1)
Set matkco = data.Offset(0, 6).Resize(, 1)
Set tienvn = data.Offset(0, 7).Resize(, 1)
End With
i = 1
j = DongDau: sott = 0
Do While i < iR + 1
soct = data.Cells(i, 1)
If IsEmpty(soct) Then GoTo bien
sott = sott + 1
Cells(j, 2) = soctgoc(i).Offset(, 3) 'ngay ht
Cells(j, 3) = soctgoc(i)
Cells(j, 4) = soctgoc(i).Offset(, 2) 'ngay ct
Cells(j, 5) = soctgoc(i).Offset(, 4) 'Dien giai
Cells(j, 10) = soctgoc(i).Offset(, 1) 'Phieu thu, chi
Cells(j, 1) = sott 'danh soTT'
solan = WF.CountIf(soctgoc, soct)
If solan = 1 Then 'voi nhung soct co 1N 1C'
Cells(j, 8) = tienvn(i)
Cells(j, 7) = matkno(i)
Cells(j + 1, 7) = matkco(i)
Cells(j + 1, 9) = tienvn(i)
Range(Cells(j + 1, 1), Cells(j + 1, 5)).Value = "-" 'danh dau - la repeat'
j = j + solan + 1
Else
sotienPS = WF.SumIf(soctgoc, soct, tienvn)
'Phan biet 1 No many Co hay nguoc lai, phan thanh 2 truong hop'
If matkno(i) <> matkno(i + 1) Then
For k = 1 To solan
Cells(j + k - 1, 7).Value = matkno(i + k - 1)
Cells(j + k - 1, 8) = tienvn(i + k - 1)
Range(Cells(j + k, 1), Cells(j + k, 5)).Value = "-" 'danh dau - la repeat'
Next
Cells(j + k - 1, 9) = sotienPS 'tienvn(i)
Cells(j + k - 1, 7) = matkco(i)
Else 'lam nguoc lai'
Cells(j, 8) = sotienPS 'tienvn(i)
Cells(j, 7) = matkno(i)
For k = 1 To solan
Cells(j + k, 7).Value = matkco(i + k - 1)
Cells(j + k, 9) = tienvn(i + k - 1)
Range(Cells(j + k, 1), Cells(j + k, 5)).Value = "-" 'danh dau - la repeat'
Next
End If
j = j + k
End If
j = j
i = i + solan
Loop
bien:
Range(Cells(DongDau, 6), Cells(j - 1, 6)).Value = "x"
Range(Cells(j, 8), Cells(j, 9)).FormulaR1C1 = "=SUM(R" & DongDau & "C:R[-1]C)" 'dong cong'
Range(Cells(j + 1, 8), Cells(j + 1, 9)).FormulaR1C1 = "=R[-1]C+R" & DongDau & "C" 'dong luy ke'
'Phan dinh dang rau ria
Cells(j, 5).Value = "Toång coäng"
Cells(j + 1, 5).Value = "Luyõ keá cuoái thaùng naøy"
Range(Cells(j, 5), Cells(j + 1, 9)).Font.Bold = True
Range(Cells(DongDau, 1), Cells(j + 1, 10)).Select
KeKhung
Set data = Nothing
With Application
.ScreenUpdating = True: .DisplayAlerts = True: .Calculation = xlCalculationAutomatic
End With
End Sub
