Minh cũng có phần mềm này , cng ko biết tác giả là ai , bạn xem có dung dc ko nhé
Dưới đây là macro cho Data![e4] - Bạn chọn 1 tên bất kỳ trong danh sách đổ xuống của nó để xem kết quả
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [E4]) Is Nothing And [E4].Value <> "" Then
Dim Rng As Range
Cells.EntireRow.Hidden = False
Set Rng = Range("AB4:AK" & [ac65500].End(xlUp).Row)
Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
("W1:W2"), CopyToRange:=Range("A5:J5"), Unique:=False
With [E30]
.Offset(, -1).FormulaR1C1 = "=TCong"
.FormulaR1C1 = "=SUM(R[-24]C:R[-1]C)"
.AutoFill Destination:=Range("E30:I30"), Type:=xlFillDefault
Range(.Offset(, -1).End(xlUp).Offset(1), .Offset(-2, -1)).EntireRow.Hidden = True
.Offset(-25).Select
End With
End If
End SubĐể xài hàm CSDL, bạn phải
Chờ đi!
|
||0|0||
Để lập bào cáo nơ quá hạn trong quý 3/2009 trên cơ sở bảng số liệu như sau:
|AD|AE|AF|AG|AH|AI|AJ|AK
| NgayCT | KhHang | DĐKy | PhatSinnh | STien | CTu | NoCK | GhiChu
|6/27/09|CTi CF SMC|4.103.232||0||4.103.232|
|7/10/09|Đông hải|29.000.000||0||29.000.000|1
|7/13/09|TWT/GMD|150.000||0||150.000|2
|7/13/09|TWT/GMD|150.000||0||150.000|3
|7/13/09|2uang minh|6.800.000||0||6.800.000|4
|7/13/09|GS Toàn quốc|51.450.000||51.450.000|ACB21.01|0|5
|7/13/09|Thanh bình HT|60.300.000||60.300.000||0|6
|7/13/09|Trường phong|23.400.000|0|||23.400.000|7
|7/29/09|GS Toàn quốc||22.050.000|22.050.000|0||8
|7/29/09|TWT/GMD||150.000|0||0|9
|8/9/09|Đông hải||46.000.000|0|||10
|8/9/09|Đông hải||36.000.000|0|||11
|8/9/09|Đông hải||39.000.000|0|||12
|8/9/09|Thanh bình HT||81.200.000|0|||13
|8/9/09|TWT/GMD||2.546.400|0||0|14
|8/9/09|TWT/GMD||2.546.400|0||0|15
|8/9/09|TWT/GMD||2.546.400|0|||16
|
(*) Bỡi ngày 7/1/09 đầu quý không có giao dịch, nên macro sẽ tìm ngày trước đó gần nhất (6/27/09) làm mốc để lập bảng nợ quá hạn quý 3/09
(*) Đầu quý là anh Đông hải; Trong quý có 4 giao dịch. So với hôm nay (8/20/09) chỉ có 1 giao dịch (1) là quá hạn => sẽ được chuyển sang trang 'QuaHan' ?
(*) Đến anh TWT/GMD có 6 giao dịch. Trong đó có 3 giao dịch quá hạn 1 tháng => Vô trang quá hạn;
(*) 2uang minh 1 giao dịch quá hạn;
(*) Toàn quốc: 1 giao dịch đã thanh toán xong nơ.
(**) tóm lại giao dịch trước 7/20/09 còn dư nợ sẽ vô sổ đen, phải không?
(Đáng ra những dữ liệu này các bạn phải cung cấp - Chán các bạn quá đi mất!)
Sub QuaHan()
Dim Dat As Date, Thg As Integer, fRw As Long, eRw As Long
Dim Temp, DFormat As String
Dim Rng As Range, sRng As Range, Sh As Worksheet
Thg = Month(Date): Set Sh = Sheets("Data")
Set Rng = Sh.Range(Sh.[AD4], Sh.[aD65500].End(xlUp)): eRw = Rng.Rows.Count + 4
If Thg = 1 Then
Dat = DateSerial(Year(Date - 1), 12, 1)
Else
Dat = DateSerial(Year(Date), Month(Date) - 1, 1)
End If
DFormat = Rng.Offset(1).NumberFormat
Rng.NumberFormat = "M/D/yyyy"
Range("B5:H" & eRw).ClearContents
Set sRng = Rng.Find(Dat, , xlFormulas, xlWhole)
If sRng Is Nothing Then
For Thg = 1 To (Date - Dat)
If Not Rng.Find(Dat + Thg) Is Nothing Then
fRw = Rng.Find(Dat + Thg).Row: Exit For
End If
Next Thg
Else
fRw = sRng.Row
End If
Thg = [B4].Interior.ColorIndex
[A4].Resize(, 8).Interior.ColorIndex = IIf(Thg < 42, Thg + 1, 34)
If fRw <> 0 Then
For Thg = fRw To eRw
If Date - Sh.Cells(Thg, "AD").Value > 30 And Sh.Cells(Thg, "AJ").Value > 0 Then
With [B65500].End(xlUp)
.Offset(1).Value = Sh.Cells(Thg, "AE").Value 'KHg'
.Offset(1, 1).Resize(, 2).Value = Sh.Cells(Thg, "Ac").Resize(, 2).Value
.Offset(1, 3).Value = Sh.Cells(Thg, "AH").Value
.Offset(1, 4).Value = Date + 30 - Sh.Cells(Thg, "AD").Value
.Offset(1, 5).Value = Sh.Cells(Thg, "Ag").Value
Temp = Sh.Cells(Thg, "Ak").Value
.Offset(1, 6).Value = IIf(Temp = "", Sh.Cells(Thg, "Aj").Value, Temp)
End With
End If
Next Thg
End If
Rng.NumberFormat = DFormat
End SubTrong file đính kèm của mình, anh chàng gạch men HG này có lần giao dịch cuối cùng là 11/10 của năm trước mà;
Còn trong báo cáo chỉ liết kê nợ quá hạn từ 1/7/2009 đến nay thôi!
Chắc chúng ta chưa hiểu ý nhau!
Option Explicit
Sub CongNo()
Dim Rng As Range, cRng As Range, Clls As Range, sRng As Range, tRng As Range
Dim Sh As Worksheet, MyAdd As String, Rws As Long
Sheets("Data").Select: Set Sh = Sheets("Report")
Sh.Range("C7:l" & Sh.[c65500].End(xlUp).Row + 7).Clear
Set cRng = Range([Y2], [Y65500].End(xlUp))
Set Rng = Range([Ae4], [Ae65500].End(xlUp))
Rws = Sh.[B5].Interior.ColorIndex
Sh.[B5].Resize(, 11).Interior.ColorIndex = IIf(Rws < 42, Rws + 1, 34)
For Each Clls In cRng
Set sRng = Rng.Find(Clls.Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then
MyAdd = sRng.Address
Do
Sh.[e65500].End(xlUp).Offset(1, -2).Resize(, 9).Value = _
sRng.Offset(, -2).Resize(, 9).Value
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
End If
Set tRng = Sh.[e65500].End(xlUp)
tRng.Offset(1).FormulaR1C1 = "=TCong"
tRng.Offset(1).Resize(, 6).Font.Bold = True
If tRng.Offset(-1).Value <> tRng.Offset(1).Value Then
Rws = tRng.Row - tRng.Offset(-1, -1).End(xlUp).Row + 1
tRng.Offset(1, 1).FormulaR1C1 = "=SUM(R[-" & Rws & "]C:R[-1]C)"
tRng.Offset(1, 1).AutoFill Destination:=tRng.Offset(1, 1).Resize(, 3)
tRng.Offset(1, 5).FormulaR1C1 = "=SUM(R[-" & Rws & "]C:R[-1]C)"
Else
tRng.Offset(1, 1).FormulaR1C1 = "=SUM(R[-1]C)"
tRng.Offset(1, 5).FormulaR1C1 = "=SUM(R[-1]C)"
End If
Next Clls
Sh.Select
End Subbạn hãy dùng các hàm trong excel để công việc ghi sổ được đơn giản hơn như hàm Vlookup, Hlookup, I F, Sumif,...
Bạn dùng công thức Sumproduct hoạc công thức mảng đều được. nhưng theo mình bạn nên xử dụng sumproduct để cho máy xử lý nhanh hơn và có thể dùng Name động để giảm bớt dung lượng của file
anh ơi cho em xin cái pass đi anh
Cho mình pass với ạ, mình điều chỉnh thông tin k được, thanks
