Đây là code chính để thực hiện ứng dụng này cho bạn!
[GPECODE=vb]
Private Sub TeamSetting(Optional ByRef IsOK As Boolean, Optional ByRef TeamNumber As Long)
Dim SoDoi As Long, IsCheck As Boolean, EndRow As Long
SoDoi = Val(TeamPlan.Range("A1"))
EndRow = DSDK.Range("B10000").End(xlUp).Row
TeamPlan.Range("A6:M1000").Clear
''Ngan cac so lon hon va nho hon tu 10 den 20 doi:
If SoDoi < 3 Or SoDoi > 41 Then
MsgBox "Tai sheet 'TEAM_PLAN', cell 'A1', ban chua chon gia tri nao!"
Exit Sub
End If
If SoDoi <> EndRow - 5 Then
Dim MyMsg As Long
MyMsg = MsgBox("Tai cell A1 ban nhap khac voi Tong So Doi trong sheet 'DSDK'," & vbLf & vbLf & _
"Ban se lam gi voi cac muc duoi day?" & vbLf & vbLf & _
"- Bam Yes neu ban muon o A1 duoc nhap Tong So Doi hien co." & vbLf & vbLf & _
"- Bam No neu ban muon co cai So Do cho so doi ma ban nhap tai o A1." & vbLf & vbLf & _
"- Bam Cancel neu ban huy thuc hien thao tac nay.", _
vbQuestion + vbYesNoCancel, "THÔNG BÁO")
If MyMsg = vbYes Then
SoDoi = EndRow - 5
TeamPlan.Range("A1") = SoDoi
ElseIf MyMsg = vbNo Then
IsCheck = True
Else
Exit Sub
End If
End If
''2 bien nay dung de kiem tra o thu tuc XuatFile
IsOK = True: TeamNumber = SoDoi
Dim RowDauBang(), RowCuoiBang()
Dim FirstRow As Long, LastRow As Long
''Mang lay so hang dau cua bang:
RowDauBang = Array(1, 10, 19, 28, 38, 48, 59, 70, 85, 100, 117, 134, 152, 167, _
183, 199, 220, 241, 263, 285, 305, 325, 348, 371, 399, 427, _
459, 484, 518, 552, 580, 608, 644, 680, 716, 752, 788, 824)
''Mang lay so hang cuoi (bao gom hang trong) cua bang:
''(mang dau va mang cuoi phai doi xung gia tri nhau theo dung vi tri)
RowCuoiBang = Array(9, 18, 27, 37, 47, 58, 69, 84, 99, 116, 133, 151, 166, 182, _
198, 219, 240, 262, 284, 304, 324, 347, 370, 398, 426, 458, _
483, 517, 551, 579, 607, 643, 679, 715, 751, 787, 823, 861)
Select Case SoDoi
Case 3, 4
SoDoi = 0
Case Else
SoDoi = SoDoi - 4
End Select
FirstRow = RowDauBang(SoDoi)
LastRow = RowCuoiBang(SoDoi)
PlanTemplate.Range("A" & FirstRow & ":M" & LastRow).Copy TeamPlan.Range("A6")
If IsCheck Then Exit Sub
Dim LastRange As Range
Dim ArrTenDoi(), ArrBocTham(), ArrBangA(), ArrBangB()
Dim r1 As Long, r2 As Long, ubd As Long, LastNumber As Long
With DSDK.Range("A6:E" & EndRow)
''Sap xep theo cot Boc Tham So:
.Sort DSDK.Range("E6")
ArrTenDoi = DSDK.Range("B6:B" & EndRow)
ArrBocTham = DSDK.Range("E6:E" & EndRow)
''Tra lai sap xep theo STT:
.Sort DSDK.Range("A6")
End With
Set LastRange = TeamPlan.Range("A1000").End(xlUp)
EndRow = LastRange.Row
LastNumber = LastRange.Value
ArrBangA = TeamPlan.Range("A8:B" & EndRow)
If TeamNumber > 32 Then
ArrBangB = TeamPlan.Range("L8:M" & EndRow)
Else
ArrBangB = TeamPlan.Range("J8:K" & EndRow)
End If
r2 = 1
ubd = UBound(ArrBangA)
For r1 = 1 To LastNumber
For r2 = r2 To ubd
If ArrBangA(r2, 1) = ArrBocTham(r1, 1) Then
ArrBangA(r2, 2) = ArrTenDoi(r1, 1)
r2 = r2 + 1
Exit For
End If
Next
Next
r2 = 1
For r1 = LastNumber + 1 To UBound(ArrTenDoi)
For r2 = r2 To ubd
If ArrBangB(r2, 2) = ArrBocTham(r1, 1) Then
ArrBangB(r2, 1) = ArrTenDoi(r1, 1)
r2 = r2 + 1
Exit For
End If
Next
Next
TeamPlan.Range("A8:B" & EndRow) = ArrBangA
If TeamNumber > 32 Then
TeamPlan.Range("L8:M" & EndRow) = ArrBangB
Else
TeamPlan.Range("J8:K" & EndRow) = ArrBangB
End If
End Sub
[/GPECODE]
Tải file về và kiểm nghiệm xem đã như ý bạn chưa nhé!
