Thuyanhanoi
Thành viên thường trực




- Tham gia
- 15/10/12
- Bài viết
- 304
- Được thích
- 154
- Nghề nghiệp
- Nhân viên
- Em có "vọc" một đoạn code lọc và chia danh sách như sau:
- Toàn bộ danh sách tại sheet(DATA) nay cần lọc theo (ngành; hệ đào tạo) sang sheet(DS_LOP) và phân chia theo số lớp cần chia được nhập vào từ cell [P5].
- Code trên mới chỉ lọc được 1 phần danh sách (chưa đúng với yêu cầu)
- Kết quả lọc và chia danh sách (đúng) em đã làm thủ công trong file đính kèm.
- Em mong được các anh chị sửa giúp code trên để lọc được đúng yêu cầu như trong file đính kèm.
- Em xin cảm ơn !.
Mã:
Option Explicit
Public Sub Danh_sach_lop()
Application.ScreenUpdating = False
Dim I As Long, J As Long, K As Long, sArr(), dArr(), Nganh As String, He As String, Ma As String
Dim So_bat_dau As Long, So_lop As Long, DK As Long, Tem As Long, So_hoc_sinh As Long ', Cot As Long, Rws As Long
With Sheets("DATA")
sArr = .Range(.[A6], .[A65000].End(xlUp)).Resize(, 14).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 13)
With Sheets("DS_LOP")
Nganh = .[P1].Value
He = .[P2].Value
Ma = .[P3].Value
So_bat_dau = .[P4].Value - 1
So_lop = .[P5].Value
For I = 1 To UBound(sArr, 1)
If sArr(I, 10) = Nganh Then
If sArr(I, 11) = He Then
So_hoc_sinh = So_hoc_sinh + 1
Tem = (So_hoc_sinh \ So_lop) + 1
K = K + 1
dArr(K, 1) = K: So_bat_dau = So_bat_dau + 1
dArr(K, 2) = IIf(.[P3] <> Empty, Ma & Format(So_bat_dau, "000"), sArr(I, 2))
For J = 3 To 13
dArr(K, J) = sArr(I, J)
Next J
If K = Tem Then
'So_bat_dau = 0
'Cot = J
'dArr(K, J) = sArr(I, J)
End If
End If
End If
Next I
If K Then
With .[A7].Resize(Tem, 13)
.Value = dArr
.Borders.LineStyle = 1
.Borders(xlInsideHorizontal).Weight = xlHairline
End With
.[C7].Resize(Tem, 2).Borders(xlInsideVertical).LineStyle = xlNone
End If
End With
Application.ScreenUpdating = True
End Sub
- Code trên mới chỉ lọc được 1 phần danh sách (chưa đúng với yêu cầu)
- Kết quả lọc và chia danh sách (đúng) em đã làm thủ công trong file đính kèm.
- Em mong được các anh chị sửa giúp code trên để lọc được đúng yêu cầu như trong file đính kèm.
- Em xin cảm ơn !.
File đính kèm
Lần chỉnh sửa cuối: