Trợ giúp code tự động thêm dòng và tính trung bình cân nặng của lớp học.

Mắt Nâu Bồ Câu

Thành viên mới
Nhờ mọi người viết giúp code tự động tách và thêm dòng của bảng A và tự động tính trung bình cân nặng của lớp học Của bảng A như bảng B (theo như hình up). Và thêm dòng "Trung bình cân nặng h/s lớp (2, 6A1, 6C1......như hình bảng B)" như hình vẽ. Link File mình có để bên dưới.
Xin cảm ơn các bạn nhiều nhiều.Giúp mình với nhé.
Bạn cần đăng nhập để thấy hình ảnh

 

Binana

Thành viên mới
Mình Không biết code. Nhưng với dữ liệu của bạn có thể dùng PivotTable để làm cũng ổn
Bạn cần đăng nhập để thấy hình ảnh

Còn nếu VBA thì chờ thành viên khác giúp
 

Mắt Nâu Bồ Câu

Thành viên mới
Mình Không biết code. Nhưng với dữ liệu của bạn có thể dùng PivotTable để làm cũng ổn
Bạn cần đăng nhập để thấy hình ảnh

Còn nếu VBA thì chờ thành viên khác giúp
Cảm ơn bạn. Mình không biết sử dụng PivotTable và có đọc qua nhưng mình muốn dùng code vba chạy hơn. đang mong có sự trợ giúp có code.
 

thanhphong

Thành viên mới
Cho mình hỏi mấy điều sau:
1. Dữ liệu luôn bắt đầu từ dòng 4?
2. Danh sách học sinh luôn được xếp theo lớp như data bạn đưa ra? hay là có trường hợp xếp lộn xộn lớp nọ lớp kia?
3. Tại sao phải tách dòng để điền cân nặng?
Giả sử tôi ghi thông tin vào cột bên cạnh thì sao?
Bạn cần đăng nhập để thấy hình ảnh
 

Mắt Nâu Bồ Câu

Thành viên mới
Cho mình hỏi mấy điều sau:
1. Dữ liệu luôn bắt đầu từ dòng 4?
2. Danh sách học sinh luôn được xếp theo lớp như data bạn đưa ra? hay là có trường hợp xếp lộn xộn lớp nọ lớp kia?
3. Tại sao phải tách dòng để điền cân nặng?
Giả sử tôi ghi thông tin vào cột bên cạnh thì sao?
Bạn cần đăng nhập để thấy hình ảnh
Mình trả lời mấy câu hỏi của bạn.
1. Dữ liệu đặt ở dòng 4
2. Danh sách lớp sau khi sort thì nó vào trật tự các lớp như thế rồi. chỉ có mình thêm học sinh vào thì lại thì bước đó mình sort theo lớp được.
3. Mình muốn thêm hàng vì giả sử mình có thêm một 1.2.3...cột chỉ chỉ tiêu nữa ví dụ như nhiều cao nữa(theo hình mình up) bên dưới
Vì mình chưa tìm được điều kiện để tách dòng lớp 2 và 6B1 và tách giữa 6B1 và 6C1 và mặc định khi thêm các lớp khác 6D1, 7A1 chẳng hạn. khi chạy macro nó sẽ tự tách. bạn hiểu ý mình không nhỉ. Nếu làm kiểu của bạn thì mình chỉ tính được trung bình cho một cột, mình muốn tách như hình vẽ có thể nó rõ ràng hơn. cảm ơn bạn đã quan tâm.
Bạn cần đăng nhập để thấy hình ảnh
 
Sửa lần cuối:

thanhphong

Thành viên mới
Code đơn giản đáp ứng yêu cầu của bạn:
Mã:
Sub tuhocvba1008()
    Dim rend    As Long   'Dong cuoi
    Dim i       As Long
    Dim shn     As String 'Ten sheet lam viec. Ex: sheet1
    Dim lop     As String 'ten lop
    Dim cnt     As Long 'Dem so luong hoc sinh trong mot lop
    Dim cn      As Double 'Can nang
    Const rbd   As Long = 4 'Dong bat dau
    shn = ActiveSheet.Name
    rend = ThisWorkbook.Sheets(shn).Cells(Rows.Count, 1).End(xlUp).Row
    If rend < rbd Then Exit Sub 'Ket thuc chuong trinh vi khong tim thay du lieu
    'Sap xep lai du lieu, tranh truong hop du lieu xep lung tung
    'Xep theo ten lop
    'Tham khao sort:
    'https://tuhocvba.net/threads/thuc-thi-sap-xep-du-lieu-bang-doi-tuong-sort.171/

    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Cells(rbd, 1), Order:=xlDescending
        .SetRange Range(Cells(rbd, 1), Cells(rend, 3)) 'Vi co 3 cot du lieu, neu co nhieu cot du lieu thi phai sua code cho nay
        .Header = xlNo
        .Apply
    End With
    lop = "tuhocvba.net" 'khoi tao thong so ban dau
    cnt = 0
    cn = 0
    For i = rbd To rend Step 1
        If Cells(i, 1) <> lop And Cells(i, 1) <> "" Then
            'Kiem tra phat hien lop moi thi tach dong
            If cnt <> 0 Then
                Rows(i).Insert Shift:=xlDown
                rend = rend + 1
                Cells(i, 3) = cn / cnt  'ghi can nang trung binh
                'Reset lai gia tri
                cn = 0
                cnt = 0
            Else
                'Lan dau tien phat hien data
                'gan ten lop moi
                lop = Cells(i, 1)
                cnt = 1
                cn = Cells(i, 3)
            End If
        ElseIf Cells(i, 1) = lop And Cells(i, 1) <> "" Then
                cnt = cnt + 1
                cn = cn + Cells(i, 3)
        End If
    Next i
    If cnt <> 0 Then
        Cells(rend + 1, 3) = cn / cnt 'ghi can nang trung binh lan cuoi
    End If

    MsgBox "Da hoan thanh"
    
End Sub
Bạn nên thiết định cột C, cụ thể từ ô C4 trở đi, chỉ định dạng số có một chữ số sau dấu phẩy.
Bạn cần đăng nhập để thấy hình ảnh

Kết quả chạy code:
Bạn cần đăng nhập để thấy hình ảnh
 

Mắt Nâu Bồ Câu

Thành viên mới
Code đơn giản đáp ứng yêu cầu của bạn:
Mã:
Sub tuhocvba1008()
    Dim rend    As Long   'Dong cuoi
    Dim i       As Long
    Dim shn     As String 'Ten sheet lam viec. Ex: sheet1
    Dim lop     As String 'ten lop
    Dim cnt     As Long 'Dem so luong hoc sinh trong mot lop
    Dim cn      As Double 'Can nang
    Const rbd   As Long = 4 'Dong bat dau
    shn = ActiveSheet.Name
    rend = ThisWorkbook.Sheets(shn).Cells(Rows.Count, 1).End(xlUp).Row
    If rend < rbd Then Exit Sub 'Ket thuc chuong trinh vi khong tim thay du lieu
    'Sap xep lai du lieu, tranh truong hop du lieu xep lung tung
    'Xep theo ten lop
    'Tham khao sort:
    'https://tuhocvba.net/threads/thuc-thi-sap-xep-du-lieu-bang-doi-tuong-sort.171/

    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Cells(rbd, 1), Order:=xlDescending
        .SetRange Range(Cells(rbd, 1), Cells(rend, 3)) 'Vi co 3 cot du lieu, neu co nhieu cot du lieu thi phai sua code cho nay
        .Header = xlNo
        .Apply
    End With
    lop = "tuhocvba.net" 'khoi tao thong so ban dau
    cnt = 0
    cn = 0
    For i = rbd To rend Step 1
        If Cells(i, 1) <> lop And Cells(i, 1) <> "" Then
            'Kiem tra phat hien lop moi thi tach dong
            If cnt <> 0 Then
                Rows(i).Insert Shift:=xlDown
                rend = rend + 1
                Cells(i, 3) = cn / cnt  'ghi can nang trung binh
                'Reset lai gia tri
                cn = 0
                cnt = 0
            Else
                'Lan dau tien phat hien data
                'gan ten lop moi
                lop = Cells(i, 1)
                cnt = 1
                cn = Cells(i, 3)
            End If
        ElseIf Cells(i, 1) = lop And Cells(i, 1) <> "" Then
                cnt = cnt + 1
                cn = cn + Cells(i, 3)
        End If
    Next i
    If cnt <> 0 Then
        Cells(rend + 1, 3) = cn / cnt 'ghi can nang trung binh lan cuoi
    End If

    MsgBox "Da hoan thanh"
   
End Sub
Bạn nên thiết định cột C, cụ thể từ ô C4 trở đi, chỉ định dạng số có một chữ số sau dấu phẩy.
Bạn cần đăng nhập để thấy hình ảnh

Kết quả chạy code:
Bạn cần đăng nhập để thấy hình ảnh
Cảm ơn @thanhphong nhiều nhé đúng ý của mình rồi. Cảm ơn bạn nhiều nhé.
 

tuhocvba

Administrator
Thành viên BQT
Code sai đấy, phải sửa lại như này mới là đúng.
Trong vòng lặp for next, dù cho thay đổi giá trị đích đến (rend), thì i cũng chỉ chạy tới rend ban đầu được gọi ở đầu for next.
Vì vậy có thể khắc phục là dùng do loop until.
Các dòng code tô sáng dưới đây là các vị trí phải sửa.
Vì vậy code trên phải sửa là:
Mã:
Sub tuhocvba1008()
    Dim rend    As Long   'Dong cuoi
    Dim i       As Long
    Dim shn     As String 'Ten sheet lam viec. Ex: sheet1
    Dim lop     As String 'ten lop
    Dim cnt     As Long 'Dem so luong hoc sinh trong mot lop
    Dim cn      As Double 'Can nang
    Const rbd   As Long = 4 'Dong bat dau
    shn = ActiveSheet.Name
    rend = ThisWorkbook.Sheets(shn).Cells(Rows.Count, 1).End(xlUp).Row
    If rend < rbd Then Exit Sub 'Ket thuc chuong trinh vi khong tim thay du lieu
    'Sap xep lai du lieu, tranh truong hop du lieu xep lung tung
    'Xep theo ten lop
    'Tham khao sort:
    'https://tuhocvba.net/threads/thuc-thi-sap-xep-du-lieu-bang-doi-tuong-sort.171/

    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Cells(rbd, 1), Order:=xlDescending
        .SetRange Range(Cells(rbd, 1), Cells(rend, 3)) 'Vi co 3 cot du lieu, neu co nhieu cot du lieu thi phai sua code cho nay
        .Header = xlNo
        .Apply
    End With
    lop = "tuhocvba.net" 'khoi tao thong so ban dau
    cnt = 0
    cn = 0
    i = rbd
    Do Until i > rend
    
        If Cells(i, 1) <> lop And Cells(i, 1) <> "" Then
            'Kiem tra phat hien lop moi thi tach dong
            If cnt <> 0 Then
                'fix loi
                lop = Cells(i, 1)
                Rows(i).Insert Shift:=xlDown
                rend = rend + 1
                Cells(i, 3) = cn / cnt  'ghi can nang trung binh
                'Reset lai gia tri
                cn = 0
                cnt = 0
            Else
                'Lan dau tien phat hien data
                'gan ten lop moi
                lop = Cells(i, 1)
                cnt = 1
                cn = Cells(i, 3)
            End If
        ElseIf Cells(i, 1) = lop And Cells(i, 1) <> "" Then
                cnt = cnt + 1
                cn = cn + Cells(i, 3)
        End If
        i = i + 1
    Loop
    If cnt <> 0 Then
        Cells(rend + 1, 3) = cn / cnt 'ghi can nang trung binh lan cuoi
    End If

    MsgBox "Da hoan thanh"
    
End Sub
Bạn chạy lại code này xem đúng chưa nhé.
 

thanhphong

Thành viên mới
@Mắt Nâu Bồ Câu : Mình sửa lại data input và code của mình ở bài #6 chạy không đúng nữa.
Bạn cần đăng nhập để thấy hình ảnh

Lớp 2 không tính được trung bình.
Vì vậy: Bạn dùng code của bài nhé. Mình thấy code này chạy ok với data demo của mình tự tạo.
Bạn cần đăng nhập để thấy hình ảnh
 

Mắt Nâu Bồ Câu

Thành viên mới
@Mắt Nâu Bồ Câu : Mình sửa lại data input và code của mình ở bài #6 chạy không đúng nữa.
Bạn cần đăng nhập để thấy hình ảnh

Lớp 2 không tính được trung bình.
Vì vậy: Bạn dùng code của bài nhé. Mình thấy code này chạy ok với data demo của mình tự tạo.
Bạn cần đăng nhập để thấy hình ảnh
Mình cũng thêm một,2 dữ liệu thì cũng bị lỗi như bạn nói. vậy xin cảm ơn @tuhocvba nhiều nhiều và cũng cảm ơn thanh phong đã quan tâm. (.Xin được học hỏi nhiều từ các bạn).Chúc các bạn một buổi tối vui vẻ.
 
Top