Đoạn Code VBA này dùng làm gì đây ?

[SA_DQ]

VB làm gì đây?

Sub BCNgay()
On Error GoTo Loi_BCNgay
Const BDau = 5

Dim SMA As Integer, SMB As Integer, SMC As Integer, SMD As Integer
Dim VtriD As Integer, VTriG As Integer, VTriC As Integer
Dim NgaySX, MVTr As Integer, SMe As Integer
Dim BDNgay As Integer, CuoiKy As Integer
Dim TTCa As String, CaD As String, CaG As String, CaC As String
ReDim MChu(1 To 3) As String
100 '. Bước 1
Sheets("BC").Select: Cells.Select
Selection.EntireRow.Hidden = False
For ii = 1 To 3
SMA = 5 + 11 * (ii - 1)
Chu = "A" & CStr(SMA) & ":W" & CStr(SMA + 9): Range(Chu).Select
Selection.ClearContents
For SMB = SMA To (SMA + 9)
Chu = "B" & CStr(SMB): Range(Chu).Select
ActiveCell.Value = "S"
Next SMB
Next ii
101 '. Bước 2 :banana:
Range("K1").Select 'VTrí Ghi Ngày BC:
NgaySX = ActiveCell.Value
If CVDate(NgaySX) > #7/13/2007# Then Exit Sub
Sheets("CSDL").Select: Columns("A:Y").Select
'A2: Ngaøy ; C2: Soá meû
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,Key2:=Range("C2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= False, Orientation:=xlTopToBottom
102 '. Bước 3 :biggrin:
Columns("A:Y").Select
Range("A1:Y932").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"AA1:AY2"), CopyToRange:=Columns("BA:BY"), Unique:=False
103 '.
ii = 1: BDNgay = 0
SMA = 0: SMB = 0
SMC = 0: SMD = 0
TTCa = "?"
Do
ii = 1 + ii
Chu = "A" & CStr(ii): Range(Chu).Select 'A: Cột NgàySX
If ActiveCell.Value = 0 Or ActiveCell.Value > NgaySX Then
CuoiKy = ii - 1: Exit Do
End If
If ActiveCell.Value = NgaySX Then
If BDNgay = 0 Then BDNgay = ii
Chu = "B" & CStr(ii): Range(Chu).Select 'B: Coät CaSX
104 '.
If UCase$(ActiveCell.Value) = "A" Then SMA = 1 + SMA
If UCase$(ActiveCell.Value) = "B" Then SMB = 1 + SMB
If UCase$(ActiveCell.Value) = "C" Then SMC = 1 + SMC
If UCase$(ActiveCell.Value) = "D" Then SMD = 1 + SMD
If UCase$(ActiveCell.Value) <> Left(TTCa, 1) Then
TTCa = UCase$(ActiveCell.Value) & TTCa
End If
End If
Loop
105 '. :
CaD = Mid(TTCa, 3, 1): CaC = Left(TTCa, 1)
CaG = Mid(TTCa, 2, 1): If Len(TTCa) < 2 Then Exit Sub ' Function
106 '. :
VtriD = Choose(Asc(CaD) - 64, SMA, SMB, SMC, SMD)
VTriG = Choose(Asc(CaG) - 64, SMA, SMB, SMC, SMD)
VTriC = Choose(Asc(CaC) - 64, SMA, SMB, SMC, SMD)
ii = BDNgay + VtriD - 1
MChu(1) = "B" & CStr(BDNgay) & ":X" & CStr(ii) 'X: Coät cuoái CSDL
ii = 1 + ii
MChu(2) = "B" & CStr(ii) & ":X" & CStr(ii + VTriG - 1) ' Ntr
ii = ii + VTriG
MChu(3) = "B" & CStr(ii) & ":X" & CStr(ii + VTriC - 1) ' Ntr
MVTr = BDau ' Không thể chuyển thông số bằng biến mãng được!
107 '. :
For ii = 1 To 3
Sheets("CSDL").Select: Range(MChu(ii)).Select
Selection.Copy:
Sheets("BC").Select: Chu = "A" & CStr(MVTr)
Range(Chu).Select: ActiveSheet.Paste
Application.CutCopyMode = False
SMe = Choose(ii, VtriD, VTriG, VTriC)
MVTr = 11 + MVTr
108 '. :
TongCa MVTr, SMe
Next ii

For ii = 1 To 3
VtriD = Choose(ii, 36, 25, 14)
VTriC = Choose(ii, 27, 16, 5)
For SMe = VtriD To VTriC Step -1
Chu = "B" & CStr(SMe): Range(Chu).Select ' 'B': Số mẽ
If Len(ActiveCell.Value) < 2 Then
Chu = CStr(SMe) & ":" & CStr(SMe)
Rows(Chu).Select
1080 Selection.EntireRow.Hidden = True
Else
Exit For
End If
Next SMe
Next ii
Range("D9").Select
Sheets("CSDL").Select
Chu = "BA" & CStr(CuoiKy + 1) & ":BZ999": Range(Chu).Select
Selection.ClearContents
Sheets("BC").Select

Err_BCNgay: Exit Sub
Loi_BCNgay: Select Case Err
Case 5, 94, 1004
Resume Next
Case Else
Chu = CStr(Err) & ": " & Error$() & "; Dong: " & Str(Erl)
End Select
MsgBox Chu: Resume Err_BCNgay
End Sub

 

[SA_DQ]

Thay đổi đề tài thôi!

Cho gởi nhờ giúp lưu dùm đoạn mã với nha!

 

[SA_DQ]

Đố Vui Có Khen!

Các Bạn thử đoán xem các bước trong đoạn mã trên làm những gi?