Lọc và chia danh sách (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

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:
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
- 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 !.
 

File đính kèm

Lần chỉnh sửa cuối:
- Được Bác sửa code và giải thích em thấy rất rễ hiểu. Em cảm ơn Bác nhiều
- Em bị kẹt như "Gà mắc tóc" không giải quyết được. Trước em mới viết được lấy ra tổng danh sách của từng ngành theo hệ đào tạo rồi chia thủ công. Nên em đưa lên đây hỏi các Bác để tìm giải pháp về sau.
- Với điều kiện lọc danh sách và chia lớp như vậy; Các bác có cách nào khác để lọc và chia xin hay hướng dẫn giúp em để việc lọc và in danh sách tưng lớp là nhanh nhất không ạ?. Như trường hợp em đưa ra thì vẫn phải thủ công một phần nữa là nhập tên người lập danh sách xuống phía dưới mỗi lớp và chỉnh sao cho mỗi danh sách lớp nằm trong 1 trang in!.
- Em xin cảm ơn!.

Gửi bạn file đính kèm đã sửa lại sub "Danh_sach_lop" chính xác hơn.
Về phần in ấn có lẽ là bạn chờ thành viên khác trên diễn đàn hỗ trợ vậy nhé
 

File đính kèm

Upvote 0
Thế là làm lại từ đầu rồi ! Đáng ra bạn cần mọi người giúp cho công việc thì nói rõ yêu cầu để mọi người giúp ! Việc hoc, tìm hiểu riêng . Bạn muốn đốt cháy giai đoạn...thế mệt mọi người lắm !
- Cảm ơn bạn đã nhắc nhở. Tại mình cứ mải suy nghĩ theo cách của mình mà không ra nên chỉ nghĩ tới việc hỏi code mà quên việc lẽ ra là phải hỏi về giải pháp cho vấn đề đó.
- Nhưng với mình nó rất có giá trị vì mình hiểu được vấn đề mình đặt ra mà mình mắc kẹt không giải quyết được "Học code" bằng ví dụ thực tế của mình thì mình dễ hiểu hơn.
 
Upvote 0
Gửi bạn file đính kèm đã sửa lại sub "Danh_sach_lop" chính xác hơn.
Về phần in ấn có lẽ là bạn chờ thành viên khác trên diễn đàn hỗ trợ vậy nhé
Cảm ơn Bác gtri đã nhiệt tình giúp đỡ. Vẫn mong được Bác và mọi người nghiên cứu giúp. Em xin cảm ơn!.
 
Upvote 0
- Vấn đề lọc danh sách và chia lớp trên bài #22 đối với em như vậy là tốt rồi ạ!. Nhưng thực tế em nhận sau khi mình chia thành các lớp thì danh sách nên được lấy "ngẫu nhiên" từ sheet(DATA) để chia và những danh sách được chia này cần được "Sort".
- Thông thường nếu "Sort" trên sheet với cả danh sách thì em thực hiện như sau:
.[C7].Resize(K, 11).Sort key1:=.[D7]
Nhưng bây giờ là các nhóm danh sách vậy ta phải thực hiện việc này thế nào?.
- Em xin cảm ơn mọi sự hướng dẫn; giúp đỡ!.
 
Upvote 0
- Vấn đề lọc danh sách và chia lớp trên bài #22 đối với em như vậy là tốt rồi ạ!. Nhưng thực tế em nhận sau khi mình chia thành các lớp thì danh sách nên được lấy "ngẫu nhiên" từ sheet(DATA) để chia và những danh sách được chia này cần được "Sort".
- Thông thường nếu "Sort" trên sheet với cả danh sách thì em thực hiện như sau:

Nhưng bây giờ là các nhóm danh sách vậy ta phải thực hiện việc này thế nào?.
- Em xin cảm ơn mọi sự hướng dẫn; giúp đỡ!.
Đã hai hôm nay vẫn đề Sort danh sách theo "lớp được chia" trong chủ đề này em vẫn chưa tìm ra cách giải quyết mọi người giúp em với!.
 
Upvote 0
Gửi bạn file đính kèm đã sửa lại sub "Danh_sach_lop" chính xác hơn.
Về phần in ấn có lẽ là bạn chờ thành viên khác trên diễn đàn hỗ trợ vậy nhé
- Mấy hôm trước em ngồi xem kỹ lại thì thấy như sau:
- Nghề Công nghệ ô tô (Hệ trung cấp) có 136 học sinh; em chia là 4 lớp mà code lại chia số học sinh trên 4 lớp không bằng nhau; Em tính để mình "vọc" nhưng chưa ra kết quả sao cho số học sinh /4 lớp được chia là bằng nhau được.
- Anh gtri và mọi người có thời gian giải quyết giúp với.
 
Upvote 0
- Mấy hôm trước em ngồi xem kỹ lại thì thấy như sau:
- Nghề Công nghệ ô tô (Hệ trung cấp) có 136 học sinh; em chia là 4 lớp mà code lại chia số học sinh trên 4 lớp không bằng nhau; Em tính để mình "vọc" nhưng chưa ra kết quả sao cho số học sinh /4 lớp được chia là bằng nhau được.
- Anh gtri và mọi người có thời gian giải quyết giúp với.

Sửa dòng lệnh tính số học sinh 1 lớp.
---
Vùng xóa của 2 câu lệnh dưới ( trong 2 sub khác nhau ) nếu cần, phải mở rộng thêm để xóa hết kết quả tính cũ. Cái này bạn tự xử nhé.
Mã:
[A7].Resize(K, 13).ClearContents
hoặc
.Range("A7", "M" & UBound(Nguon)).ClearContents
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Sửa dòng lệnh tính số học sinh 1 lớp.
---
Vùng xóa của 2 câu lệnh dưới ( trong 2 sub khác nhau ) nếu cần, phải mở rộng thêm để xóa hết kết quả tính cũ. Cái này bạn tự xử nhé.
Mã:
[A7].Resize(K, 13).ClearContents
hoặc
.Range("A7", "M" & UBound(Nguon)).ClearContents
Vâng!. Cảm ơn anh nhiều nha!. Code chuẩn rồi ạ!.
 
Upvote 0
Vâng!. Cảm ơn anh nhiều nha!. Code chuẩn rồi ạ!.
Nếu bạn định sort danh sách lớp, có lẽ nhanh nhất là sort sheet DATA trước, sau đó hãy chia lớp.
dùng sort có sẵn của của excel

Nếu bạn định in từng lớp:
Lập dòng tên đuôi ( tên người lập, ngày tháng...) cách dòng cuối của lớp cuối vài dòng.
Lớp nào không in thì ẩn dòng đó đi
 
Upvote 0
Nếu bạn định sort danh sách lớp, có lẽ nhanh nhất là sort sheet DATA trước, sau đó hãy chia lớp.
dùng sort có sẵn của của excel

Nếu bạn định in từng lớp:
Lập dòng tên đuôi ( tên người lập, ngày tháng...) cách dòng cuối của lớp cuối vài dòng.
Lớp nào không in thì ẩn dòng đó đi
- Vâng Cảm ơn anh ạ!.
- Làm thế nào để có giải pháp cho việc in từng lớp với dòng tiêu đề của lớp khác nhau và dòng tên đuôi ( tên người lập, ngày tháng...) tạm thời em chưa nghĩ ra cách làm thế nào cho phù hợp, em sẽ suy nghĩ thêm.
- Vấn đề đến đây coi như là OK rồi ạ!.
- Trên thực tế việc chia lớp ở trường em được thực hiện chia thành các lớp lần lượt là (A;B;C;D...) tùy theo số lớp ở ô (P5) mà tương ứng với các lớp (A;B;C;D...) đó. Truy nhiên thì khả năng của em là không thể viết chia luôn theo mã đó được nên em mới theo phương án chia lớp ở trên. Nhưng nếu chia lớp với phần mã của mỗi học sinh trong cùng (hệ; ngành; ở các lớp A ,B, C, D,.. đó như sau: em lấy ví dụ: học sinh có số thứ tự 01: ở lớp A là 2OTA001 , học sinh số 02 là 2OTA002, ... ; học sinh có số thứ tự 01 lớp B lại là 2OTB001, học sinh số 02 là 2OTB002, ... ; với các lớp cách chia lớp và tạo mã cũng tương tự như trên thì có làm được không anh?.
 
Upvote 0
- Trên thực tế việc chia lớp ở trường em được thực hiện chia thành các lớp lần lượt là (A;B;C;D...) tùy theo số lớp ở ô (P5) mà tương ứng với các lớp (A;B;C;D...) đó. Truy nhiên thì khả năng của em là không thể viết chia luôn theo mã đó được nên em mới theo phương án chia lớp ở trên. Nhưng nếu chia lớp với phần mã của mỗi học sinh trong cùng (hệ; ngành; ở các lớp A ,B, C, D,.. đó như sau: em lấy ví dụ: học sinh có số thứ tự 01: ở lớp A là 2OTA001 , học sinh số 02 là 2OTA002, ... ; học sinh có số thứ tự 01 lớp B lại là 2OTB001, học sinh số 02 là 2OTB002, ... ; với các lớp cách chia lớp và tạo mã cũng tương tự như trên thì có làm được không anh?.

Cái này cũng không phải là khó.
- Tạo một chuỗi chữ cái ABCD...
- Thêm biến đếm để xác định vị trí sẽ tách phần tử của chuỗi trên ( giả sử là J ).
Biến này khởi đầu cho =1. Khi K=K+5 tức là sang lớp khác, sẽ cho biến J tăng thêm 1 và dùng hàm MID() tách chuỗi ABCD, nối vào mã học sinh

Bạn xử lý thử xem, mắc đâu gỡ đó.
 
Upvote 0
Cái này cũng không phải là khó.
- Tạo một chuỗi chữ cái ABCD...
- Thêm biến đếm để xác định vị trí sẽ tách phần tử của chuỗi trên ( giả sử là J ).
Biến này khởi đầu cho =1. Khi K=K+5 tức là sang lớp khác, sẽ cho biến J tăng thêm 1 và dùng hàm MID() tách chuỗi ABCD, nối vào mã học sinh

Bạn xử lý thử xem, mắc đâu gỡ đó.
- Em loay hoay làm theo hướng dẫn cả buổi tối mà code chỉ tạo mã từ "B" trở đi, em chưa hiểu vì sao lại không bắt đầu từ lớp "A"
Mã:
Public Sub Danh_sach_lop()    Application.ScreenUpdating = False
    Dim I As Long, J As Long, K As Long, m 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, Chuoi As String, Ten_lop As String
    
    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
        Chuoi = .[P6].Value
        For I = 1 To UBound(sArr, 1)
            If sArr(I, 10) = Nganh And sArr(I, 11) = He Then
                So_hoc_sinh = So_hoc_sinh + 1
            End If
        Next I
        Tem = So_hoc_sinh \ So_lop
        Tem = IIf(Tem = So_hoc_sinh / So_lop, Tem, Tem + 1) 'Sua cho nay
        So_hoc_sinh = 0
        m = 0
        For I = 1 To UBound(sArr, 1)
            If sArr(I, 10) = Nganh And sArr(I, 11) = He Then
                So_hoc_sinh = So_hoc_sinh + 1
                K = K + 1
                If So_hoc_sinh - 1 <> 0 And (So_hoc_sinh - 1) Mod Tem = 0 Then K = K + 1: m = m + 1: Ten_lop = Mid(Chuoi, m, 1)
                dArr(K, 1) = IIf(So_hoc_sinh <= Tem, So_hoc_sinh, (So_hoc_sinh - 1) Mod Tem + 1)
                So_bat_dau = So_bat_dau + 1
                dArr(K, 2) = IIf(.[P3] <> Empty, Ma & Ten_lop & Format(So_bat_dau, "000"), sArr(I, 2))
                For J = 3 To 13
                    dArr(K, J) = sArr(I, J)
                Next J
            End If
        Next I
        If K Then
            [A7].Resize(K, 13).ClearContents
            With .[A7].Resize(K, 13)
                .Value = dArr
                .Borders.LineStyle = 1
                .Borders(xlInsideHorizontal).Weight = xlHairline
            End With
            .[C7].Resize(K, 2).Borders(xlInsideVertical).LineStyle = xlNone
        End If
    End With
    Application.ScreenUpdating = True
End Sub
- Em chỉ cho cách ra 1 dòng trống để phân chia giữa các lớp Ví dụ coa 4 lớp (ABCD)
tại cột A của những dòng này sẽ điền dòng (Danh sách lớp tương ứng)
- Ô [P4] và số khởi tạo ở các danh sách bắt đầu của mỗi lớp, nhưng em chưa biết cách sửa
- Mong anh và các bạn xem file và hướng dẫn giúp em!.
 

File đính kèm

Upvote 0
- Em loay hoay làm theo hướng dẫn cả buổi tối mà code chỉ tạo mã từ "B" trở đi, em chưa hiểu vì sao lại không bắt đầu từ lớp "A"

Sửa chỗ này
Mã:
'm = 0
m = 1 'Vì ngay khi bắt đầu tính là lập tức phải tách ký tự thứ 1 của chuỗi ABCD cho lớp thứ nhất
Sửa chỗ này
Mã:
'If So_hoc_sinh - 1 <> 0 And (So_hoc_sinh - 1) Mod Tem = 0 Then K = K + 1: m = m + 1: Ten_lop = Mid(Chuoi, m, 1)

Tách Ten_Lop khỏi câu lệnh IF vì luôn phải tính Ten_Lop với mọi trường hợp của So_Hoc_Sinh
Chỉ để lại m trong IF để thay đổi vị trí tách chuỗi khi chuyển lớp

If So_hoc_sinh - 1 <> 0 And (So_hoc_sinh - 1) Mod Tem = 0 Then K = K + 1: m = m + 1
Ten_lop = Mid(Chuoi, m, 1) ' Tách Ten_Lop khỏi câu lệnh if
Bạn kiểm tra xem sao
 
Upvote 0
Sửa chỗ này
Mã:
'm = 0
m = 1 'Vì ngay khi bắt đầu tính là lập tức phải tách ký tự thứ 1 của chuỗi ABCD cho lớp thứ nhất
Sửa chỗ này
Mã:
'If So_hoc_sinh - 1 <> 0 And (So_hoc_sinh - 1) Mod Tem = 0 Then K = K + 1: m = m + 1: Ten_lop = Mid(Chuoi, m, 1)

Tách Ten_Lop khỏi câu lệnh IF vì luôn phải tính Ten_Lop với mọi trường hợp của So_Hoc_Sinh
Chỉ để lại m trong IF để thay đổi vị trí tách chuỗi khi chuyển lớp

If So_hoc_sinh - 1 <> 0 And (So_hoc_sinh - 1) Mod Tem = 0 Then K = K + 1: m = m + 1
Ten_lop = Mid(Chuoi, m, 1) ' Tách Ten_Lop khỏi câu lệnh if
Bạn kiểm tra xem sao
- Theo chỉ dẫn của anh em sửa lại code như sau:
Mã:
Public Sub Danh_sach_lop()Application.ScreenUpdating = False
    Dim I As Long, J As Long, K As Long, m 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, Chuoi As String, Ten_lop As String
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
    Chuoi = .[P6].Value
    For I = 1 To UBound(sArr, 1)
        If sArr(I, 10) = Nganh And sArr(I, 11) = He Then
            So_hoc_sinh = So_hoc_sinh + 1
        End If
    Next I
    Tem = So_hoc_sinh \ So_lop
    Tem = IIf(Tem = So_hoc_sinh / So_lop, Tem, Tem + 1) 'Sua cho nay
    So_hoc_sinh = 0
    m = 1
    For I = 1 To UBound(sArr, 1)
        If sArr(I, 10) = Nganh And sArr(I, 11) = He Then
            So_hoc_sinh = So_hoc_sinh + 1
            K = K + 1
            If So_hoc_sinh - 1 <> 0 And (So_hoc_sinh - 1) Mod Tem = 0 Then K = K + 1: m = m + 1
            If So_lop = 1 Then
                Ten_lop = ""               
            Else
                Ten_lop = Mid(Chuoi, m, 1)
            End If
            dArr(K, 1) = IIf(So_hoc_sinh <= Tem, So_hoc_sinh, (So_hoc_sinh - 1) Mod Tem + 1)
            So_bat_dau = So_bat_dau + 1
            dArr(K, 2) = IIf(.[P3] <> Empty, Ma & Ten_lop & Format(So_bat_dau, "000"), sArr(I, 2))
            For J = 3 To 13
                dArr(K, J) = sArr(I, J)
            Next J
        End If
    Next I
    If K Then
        [A7].Resize(K, 13).ClearContents
        With .[A7].Resize(K, 13)
            .Value = dArr
            .Borders.LineStyle = 1
            .Borders(xlInsideHorizontal).Weight = xlHairline
        End With
        .[C7].Resize(K, 2).Borders(xlInsideVertical).LineStyle = xlNone
    End If
End With
Application.ScreenUpdating = True
End Sub
- Mong anh hướng dẫn thêm là: Làm sao để tất cả các lớp được chia có số bắt đầu được lấy từ ô [P4]. Trong code trên em vẫn sửa được (các lớp tiếp theo không lấy số bắt đầu từ P4 mà bằng số cuối danh sách trước đó +1)
- Em muốn cho tại dòng trống thì điền vào dòng này:
"Danh sách l" & ChrW(7899) & "p" & Ten_lop
- Rất mong anh và các bạn hướng dẫn (về mặt giải thuật hay thuật toán em còn kém quá!.).
 
Upvote 0
- Em muốn cho tại dòng trống thì điền vào dòng này:
Bạn để ý câu lệnh "IF then K=K+1..." chính là chỗ mà bảng kết quả nhảy cóc 1 dòng, vậy thì chèn cái bạn cần vào đây. Câu lệnh này khi sửa có bỏ bớt 1 điều kiện để cho dòng đầu tiên của bảng kết quả có tên là lớp A

Mã:
For I = 1 To UBound(sArr, 1)
        If sArr(I, 10) = Nganh And sArr(I, 11) = He Then
'Chuyển đoạn tính Ten_Lop lên đây để dùng cho dòng muốn điền thêm
            If So_lop = 1 Then
                Ten_lop = ""
            Else
                Ten_lop = Mid(Chuoi, m, 1)
            End If
                        
            So_hoc_sinh = So_hoc_sinh + 1
            K = K + 1
            
            'If So_hoc_sinh - 1 <> 0 And (So_hoc_sinh - 1) Mod Tem = 0 Then K = K + 1: m = m + 1
'Sửa cách viết câu lệnh IF, bỏ bớt điều kiện, chèn câu cần chèn vào bảng kết quả
            If (So_hoc_sinh - 1) Mod Tem = 0 Then
            dArr(K, 1) = "Danh sách l" & ChrW(7899) & "p" & Ten_lop
            K = K + 1
            m = m + 1
            End If
                        
'Từ đây trở xuống vẫn y nguyên 
           dArr(K, 1) = IIf(So_hoc_sinh <= Tem, So_hoc_sinh, (So_hoc_sinh - 1) Mod Tem + 1)
            So_bat_dau = So_bat_dau + 1
            dArr(K, 2) = IIf(.[P3] <> Empty, Ma & Ten_lop & Format(So_bat_dau, "000"), sArr(I, 2))
            For J = 3 To 13
                dArr(K, J) = sArr(I, J)
            Next J
        End If
    Next I


Còn về ý này, chắc bạn xử lý đi thôi.
- Mong anh hướng dẫn thêm là: Làm sao để tất cả các lớp được chia có số bắt đầu được lấy từ ô [P4]. Trong code trên em vẫn sửa được (các lớp tiếp theo không lấy số bắt đầu từ P4 mà bằng số cuối danh sách trước đó +1)
Mã:
dArr(K, 2) = IIf(.[P3] <> Empty, Ma & Ten_lop & Format(So_bat_dau, "000"), sArr(I, 2))
Ở đây là So_bat_dau tăng liên tục, bạn có thể dùng hàm mod để thành giá trị lặp lại như cách tính dArr(K, 1)
Hoặc cũng có thể đưa thêm So_bat_dau vào trong câu lệnh "IF then K=K+1..." tức là khi nhảy cóc 1 dòng thì quay về =[P4]

---
Câu lệnh Application.ScreenUpdating trong trường hợp này bỏ đi cũng được vì bạn xử lý trên mảng chứ không phải range. Tốc độ chắc vẫn vậy.
 
Lần chỉnh sửa cuối:
Upvote 0
- Theo chỉ dẫn của anh em sửa lại code như sau:
Mã:
Public Sub Danh_sach_lop()Application.ScreenUpdating = False
    Dim I As Long, J As Long, K As Long, m 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, Chuoi As String, Ten_lop As String
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
    Chuoi = .[P6].Value
    For I = 1 To UBound(sArr, 1)
        If sArr(I, 10) = Nganh And sArr(I, 11) = He Then
            So_hoc_sinh = So_hoc_sinh + 1
        End If
    Next I
    Tem = So_hoc_sinh \ So_lop
    Tem = IIf(Tem = So_hoc_sinh / So_lop, Tem, Tem + 1) 'Sua cho nay
    So_hoc_sinh = 0
    m = 1
    For I = 1 To UBound(sArr, 1)
        If sArr(I, 10) = Nganh And sArr(I, 11) = He Then
            So_hoc_sinh = So_hoc_sinh + 1
            K = K + 1
            If So_hoc_sinh - 1 <> 0 And (So_hoc_sinh - 1) Mod Tem = 0 Then K = K + 1: m = m + 1
            If So_lop = 1 Then
                Ten_lop = ""               
            Else
                Ten_lop = Mid(Chuoi, m, 1)
            End If
            dArr(K, 1) = IIf(So_hoc_sinh <= Tem, So_hoc_sinh, (So_hoc_sinh - 1) Mod Tem + 1)
            So_bat_dau = So_bat_dau + 1
            dArr(K, 2) = IIf(.[P3] <> Empty, Ma & Ten_lop & Format(So_bat_dau, "000"), sArr(I, 2))
            For J = 3 To 13
                dArr(K, J) = sArr(I, J)
            Next J
        End If
    Next I
    If K Then
        [A7].Resize(K, 13).ClearContents
        With .[A7].Resize(K, 13)
            .Value = dArr
            .Borders.LineStyle = 1
            .Borders(xlInsideHorizontal).Weight = xlHairline
        End With
        .[C7].Resize(K, 2).Borders(xlInsideVertical).LineStyle = xlNone
    End If
End With
Application.ScreenUpdating = True
End Sub
- Mong anh hướng dẫn thêm là: Làm sao để tất cả các lớp được chia có số bắt đầu được lấy từ ô [P4]. Trong code trên em vẫn sửa được (các lớp tiếp theo không lấy số bắt đầu từ P4 mà bằng số cuối danh sách trước đó +1)
- Em muốn cho tại dòng trống thì điền vào dòng này:
- Rất mong anh và các bạn hướng dẫn (về mặt giải thuật hay thuật toán em còn kém quá!.).

Hình như bắt đầu từ DATA, yêu cầu chưa hợp lý nên loay hoay như tơ vò.
- Mọi chuyện nên làm từ DATA, thành 1 CSDL chuẩn, từ đó muốn lọc cái gì thì làm cái đó.
- Trong DATA Tạo Mã cho cột B, xếp lớp cho cột O. (Tự làm cho từng ngành)
+Bấm tạo mã
+ Chọn ngành, Hệ đào tạo, số lớp cần chia
+ Bấm Chia Lớp
- Trong DS_LOP, chọn mã ô P2, Bấm nút DS SV
- Sheet Chu_Thich phải tạo biểu chuẩn dò tìm từng mã, ngành,...
 

File đính kèm

Upvote 0
Nhờ mọi người trên diễn đàn có thể giúp mình viết code VBA trong Excel để tổng hợp số liệu theo từ SHEET_TONG tạo ra các sheet mới cho mỗi quận , mỗi quận là một sheet theo mẫu ở sheet bieu1. Quận tân bình em đã làm tay và đã tổng hợp xong theo mẫu ở biểu sheet bieu1, còn lại 2 quận nữa em chưa làm chưa mọi người viết giùm em , ở đây là em đưa lên 3 quận, để nhờ mọi người viết giùm, thật ra số liệu nó rất lớn, còn nhiều quận khác nữa, em chỉ đưa lên 3 quận, nhờ mọi người viết giùm em để tiện cho việc tổng hợp. Trong sheet SHEET_TONG còn có nhiều quận khác nữa.Hihi
Cảm ơn mọi người nhiều!
Nếu cái này làm mất nhiều thời gian để viết code, thì em sẽ cảm ơn và hậu tạ.
dưới đây là file mình gửi
https://drive.google.com/file/d/0B4c2di05QM0bcmk0RF9OTGJ5dms/view?usp=sharing
 

File đính kèm

Upvote 0
Bạn để ý câu lệnh "IF then K=K+1..." chính là chỗ mà bảng kết quả nhảy cóc 1 dòng, vậy thì chèn cái bạn cần vào đây. Câu lệnh này khi sửa có bỏ bớt 1 điều kiện để cho dòng đầu tiên của bảng kết quả có tên là lớp A

Mã:
For I = 1 To UBound(sArr, 1)
        If sArr(I, 10) = Nganh And sArr(I, 11) = He Then
'Chuyển đoạn tính Ten_Lop lên đây để dùng cho dòng muốn điền thêm
            If So_lop = 1 Then
                Ten_lop = ""
            Else
                Ten_lop = Mid(Chuoi, m, 1)
            End If
                        
            So_hoc_sinh = So_hoc_sinh + 1
            K = K + 1
            
            'If So_hoc_sinh - 1 <> 0 And (So_hoc_sinh - 1) Mod Tem = 0 Then K = K + 1: m = m + 1
'Sửa cách viết câu lệnh IF, bỏ bớt điều kiện, chèn câu cần chèn vào bảng kết quả
            If (So_hoc_sinh - 1) Mod Tem = 0 Then
            dArr(K, 1) = "Danh sách l" & ChrW(7899) & "p" & Ten_lop
            K = K + 1
            m = m + 1
            End If
                        
'Từ đây trở xuống vẫn y nguyên 
           dArr(K, 1) = IIf(So_hoc_sinh <= Tem, So_hoc_sinh, (So_hoc_sinh - 1) Mod Tem + 1)
            So_bat_dau = So_bat_dau + 1
            dArr(K, 2) = IIf(.[P3] <> Empty, Ma & Ten_lop & Format(So_bat_dau, "000"), sArr(I, 2))
            For J = 3 To 13
                dArr(K, J) = sArr(I, J)
            Next J
        End If
    Next I


Còn về ý này, chắc bạn xử lý đi thôi.

Mã:
dArr(K, 2) = IIf(.[P3] <> Empty, Ma & Ten_lop & Format(So_bat_dau, "000"), sArr(I, 2))
Ở đây là So_bat_dau tăng liên tục, bạn có thể dùng hàm mod để thành giá trị lặp lại như cách tính dArr(K, 1)
Hoặc cũng có thể đưa thêm So_bat_dau vào trong câu lệnh "IF then K=K+1..." tức là khi nhảy cóc 1 dòng thì quay về =[P4]

---
Câu lệnh Application.ScreenUpdating trong trường hợp này bỏ đi cũng được vì bạn xử lý trên mảng chứ không phải range. Tốc độ chắc vẫn vậy.
- Em sửa theo cách trên của anh tuy nhiên lại bị phần tên lớp chưa chuẩn
Mã:
Public Sub Danh_sach_lop()Application.ScreenUpdating = False
    Dim I As Long, J As Long, K As Long, m 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, Chuoi As String, Ten_lop As String
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
    Chuoi = .[P6].Value
    For I = 1 To UBound(sArr, 1)
        If sArr(I, 10) = Nganh And sArr(I, 11) = He Then
            So_hoc_sinh = So_hoc_sinh + 1
        End If
    Next I
    Tem = So_hoc_sinh \ So_lop
    Tem = IIf(Tem = So_hoc_sinh / So_lop, Tem, Tem + 1) 'Sua cho nay
    So_hoc_sinh = 0
    m = 1
    For I = 1 To UBound(sArr, 1)
        If sArr(I, 10) = Nganh And sArr(I, 11) = He Then
            If So_lop = 1 Then
                Ten_lop = ""
            Else
                Ten_lop = Mid(Chuoi, m, 1)
            End If
            So_hoc_sinh = So_hoc_sinh + 1
            K = K + 1
            
            If (So_hoc_sinh - 1) Mod Tem = 0 Then
            dArr(K, 1) = "Danh sách l" & ChrW(7899) & "p" & " " & Ten_lop
            K = K + 1
            m = m + 1
            End If
            
            dArr(K, 1) = IIf(So_hoc_sinh <= Tem, So_hoc_sinh, (So_hoc_sinh - 1) Mod Tem + 1)
            So_bat_dau = So_bat_dau + 1
            dArr(K, 2) = IIf(.[P3] <> Empty, Ma & Ten_lop & Format(So_bat_dau, "000"), sArr(I, 2))
            For J = 3 To 13
                dArr(K, J) = sArr(I, J)
            Next J
        End If
    Next I
    If K Then
        [A7].Resize(K, 13).ClearContents
        With .[A7].Resize(K, 13)
            .Value = dArr
            .Borders.LineStyle = 1
            .Borders(xlInsideHorizontal).Weight = xlHairline
        End With
        .[C7].Resize(K, 2).Borders(xlInsideVertical).LineStyle = xlNone
    End If
End With
Application.ScreenUpdating = True
End Sub
- Anh xem giúp với ạ!.
 

File đính kèm

Upvote 0
Hình như bắt đầu từ DATA, yêu cầu chưa hợp lý nên loay hoay như tơ vò.
- Mọi chuyện nên làm từ DATA, thành 1 CSDL chuẩn, từ đó muốn lọc cái gì thì làm cái đó.
- Trong DATA Tạo Mã cho cột B, xếp lớp cho cột O. (Tự làm cho từng ngành)
+Bấm tạo mã
+ Chọn ngành, Hệ đào tạo, số lớp cần chia
+ Bấm Chia Lớp
- Trong DS_LOP, chọn mã ô P2, Bấm nút DS SV
- Sheet Chu_Thich phải tạo biểu chuẩn dò tìm từng mã, ngành,...
Em cảm ơn Thầy Ba Tê ạ!. Vậy là em lai có thêm một cách tạo mã và chia lớp nữa.
 
Upvote 0
- Em sửa theo cách trên của anh tuy nhiên lại bị phần tên lớp chưa chuẩn - Anh xem giúp với ạ!.

Bạn xem file đính kèm.
---
Bạn sửa lại chỗ này trong code
Mã:
If (So_hoc_sinh - 1) Mod Tem = 0 Then
            m = m + K\Tem
Thành
If (So_hoc_sinh - 1) Mod Tem = 0 Then
            m = m + 1
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom