Kết quả 1 đến 9 của 9

Chủ đề: Hỏi cách tạo nút lệnh lọc và copy DL trong sheet sang book mới

  1. #1
    Ngày tham gia
    Aug 2015
    Bài viết
    0

    Hỏi cách tạo nút lệnh lọc và copy DL trong sheet sang book mới

    Em sửa file PHONGTHI.xls của thầy Nguyễn Tiến Thuỳ - Trường THCS Tú Sơn (tìm được trên mạng) để lập danh sách thi khảo sát cho trường (mẫu như file đính kèm). Sau khi nhập kết quả thi khảo sát vào sheet Danh sach em muốn tạo nút lệnh để lọc và copy danh sách kết quả theo lớp sang book mới (mẫu danh sách lấy từ sheet Mau DS tương tự như nút lệnh Lập DS phòng thi nhưng theo lớp chứ không phải theo phòng) nhưng không biết viết code như thế nào. Các bác chỉ giúp em với! Thanks!


  2. #2
    Các bác bớt chút thời gian xem và chỉ giúp em với! Thanks!

  3. #3
    zmyr0893 Guest
    Trích dẫn Gửi bởi nhunguyet0103
    Em sửa file PHONGTHI.xls của thầy Nguyễn Tiến Thuỳ - Trường THCS Tú Sơn (tìm được trên mạng) để lập danh sách thi khảo sát cho trường (mẫu như file đính kèm). Sau khi nhập kết quả thi khảo sát vào sheet Danh sach em muốn tạo nút lệnh để lọc và copy danh sách kết quả theo lớp sang book mới (mẫu danh sách lấy từ sheet Mau DS tương tự như nút lệnh Lập DS phòng thi nhưng theo lớp chứ không phải theo phòng) nhưng không biết viết code như thế nào. Các bác chỉ giúp em với! Thanks!

    Code tách lớp cho bạn


    Mã:
    Option Explicit
    Public Sub GPE()
    Dim Arr, dArr, I As Long, J As Long, K As Long, X As Long
    Dim ShMau As Worksheet, ShDs As Worksheet, Wb As Workbook
    Dim Dic As Object, Tem As String
    Application.ScreenUpdating = False
    Set Wb = ActiveWorkbook
    Set ShMau = Wb.Sheets("Mau DS")
    Set ShDs = Wb.Sheets("Danh sach")
    Arr = ShDs.Range("C2", ShDs.Range("C2").End(4)).Resize(, 10).Value2
    ReDim dArr(1 To UBound(Arr), 1 To 11)
    Set Dic = CreateObject("Scripting.Dictionary")
    ShMau.Copy
    For I = 1 To UBound(Arr)
        Tem = Arr(I, 6)
        If Not Dic.exists(Tem) Then
            Dic.Add Tem, ""
        ActiveSheet.Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = Tem
        K = 0
        For X = 1 To UBound(Arr)
            If Arr(X, 6) = Tem Then
            K = K + 1
                dArr(K, 1) = K
            For J = 1 To UBound(Arr, 2)
                dArr(K, J + 1) = Arr(X, J)
            Next J
            End If
        Next X
            ActiveSheet.Rows("9:" & K + 6).Insert Shift:=xlDown
            ActiveSheet.Range("A9").Resize(K, 11).Value = dArr
        End If
    Sheets(1).Activate
    Next I
    Set Dic = Nothing
    Application.ScreenUpdating = True
    End Sub

  4. #4
    clean190914 Guest
    Cảm ơn anh đã trợ giúp! Sau khi em thử nghiệm đoạn code anh trợ giúp thì nảy sinh vấn đề cần anh chỉ bảo thêm ạ!
    1) Sau khi chạy Code trên thì đã tách được thành các lớp riêng như mong muốn ban đầu của em 1 cách nhanh chóng nhưng nó chưa giống với đinh dạng của Sheet Mau DS mà em đã căn chỉnh theo ý trừ 2 dòng cuối của các lớp (VD: Cột ngày sinh vẫn không phải là định dạng Date; cột: Họ và, tên bị căn giữa)



    2) Vấn đề nảy sinh thêm: Vì lọc ra thành các lớp riêng rồi nên cột lớp là không cần thiết nữa nên em muốn bỏ cột lớp mà thay vào đó là cột Phòng thi còn tên lớp ở ô A5 (file đính kèm em đã thêm sheet: Mau DS_TheoLop) thì liệu có được không ạ?



    Kính mong bác xem xét và chỉ bảo em thêm ạ! Thanks!

  5. #5
    Ngày tham gia
    Aug 2015
    Bài viết
    0
    Trích dẫn Gửi bởi nhunguyet0103
    Cảm ơn anh đã trợ giúp! Sau khi em thử nghiệm đoạn code anh trợ giúp thì nảy sinh vấn đề cần anh chỉ bảo thêm ạ!
    ......................................
    Kính mong bác xem xét và chỉ bảo em thêm ạ! Thanks!
    Xem File nhé!!!!!!!!!!!!!!!!!!!!!!!!

  6. #6
    donggun Guest
    Trích dẫn Gửi bởi nhunguyet0103
    Cảm ơn anh đã trợ giúp! Sau khi em thử nghiệm đoạn code anh trợ giúp thì nảy sinh vấn đề cần anh chỉ bảo thêm ạ!
    1) Sau khi chạy Code trên thì đã tách được thành các lớp riêng như mong muốn ban đầu của em 1 cách nhanh chóng nhưng nó chưa giống với đinh dạng của Sheet Mau DS mà em đã căn chỉnh theo ý trừ 2 dòng cuối của các lớp (VD: Cột ngày sinh vẫn không phải là định dạng Date; cột: Họ và, tên bị căn giữa)



    2) Vấn đề nảy sinh thêm: Vì lọc ra thành các lớp riêng rồi nên cột lớp là không cần thiết nữa nên em muốn bỏ cột lớp mà thay vào đó là cột Phòng thi còn tên lớp ở ô A5 (file đính kèm em đã thêm sheet: Mau DS_TheoLop) thì liệu có được không ạ?



    Kính mong bác xem xét và chỉ bảo em thêm ạ! Thanks!
    Hi vọng không còn phát sinh gì nữa hén...Tôi là tôi không có thích "Phát Sinh" đâu nha. Đưa ngay từ đầu...thì không đưa lên, để làm rồi...làm lại...phát với chả sinh...[IMG]images/smilies/a00.gif[/IMG][IMG]images/smilies/a00.gif[/IMG][IMG]images/smilies/a00.gif[/IMG]


    Mã:
    Option Explicit
    Public Sub GPE()
    Dim Arr, dArr, I As Long, J As Long, K As Long, X As Long
    Dim ShMau As Worksheet, ShDs As Worksheet, Wb As Workbook
    Dim Dic As Object, Tem As String
    Application.ScreenUpdating = False
    Set Wb = ActiveWorkbook
    Set ShMau = Wb.Sheets("Mau DS_TheoLop")
    Set ShDs = Wb.Sheets("Danh sach")
    Arr = ShDs.Range("A2", ShDs.Range("A2").End(4)).Resize(, 12).Value2
    ReDim dArr(1 To UBound(Arr), 1 To 11)
    Set Dic = CreateObject("Scripting.Dictionary")
    ShMau.Copy
    For I = 1 To UBound(Arr)
        Tem = Arr(I, 8)
        If Not Dic.exists(Tem) Then
            Dic.Add Tem, ""
        ActiveSheet.Copy After:=Sheets(Sheets.Count)
        With ActiveSheet
            .Name = Tem
            K = 0
            For X = 1 To UBound(Arr)
                If Arr(X, 8) = Tem Then
                    K = K + 1
                        dArr(K, 1) = K
                    For J = 2 To 6
                        dArr(K, J) = Arr(X, J + 1)
                    Next J
                        dArr(K, 7) = Arr(X, 1)
                    For J = 8 To 11
                        dArr(K, J) = Arr(X, J + 1)
                    Next J
                End If
            Next X
            .Rows("9:" & K + 6).Insert Shift:=xlDown
            .Range("A9").Resize(K, 11).Value = dArr
            .Range("A5").Value = "L" & ChrW(7899) & "p: " & Tem
            .Range("A9").Resize(K, 11).Font.Name = "Times New Roman"
            .Range("A9").Resize(K, 11).Font.Size = 13
            .Range("A9").Resize(K, 11).Font.ColorIndex = xlAutomatic
            .Range("E9").Resize(K).NumberFormat = "dd/mm/yyyy"
            .Range("A9").Resize(K, 11).HorizontalAlignment = xlCenter
            .Range("A9").Resize(K, 11).VerticalAlignment = xlCenter
            .Range("C9").Resize(K, 2).HorizontalAlignment = xlLeft
            .Range("C9").Resize(K, 2).VerticalAlignment = xlCenter
        End With
        End If
    Sheets(1).Activate
    Next I
    Sheets(1).Delete
    Set Dic = Nothing
    Application.ScreenUpdating = True
    End Sub

  7. #7
    dieulypretty Guest
    Trích dẫn Gửi bởi hpkhuong
    Hi vọng không còn phát sinh gì nữa hén...Tôi là tôi không có thích "Phát Sinh" đâu nha. Đưa ngay từ đầu...thì không đưa lên, để làm rồi...làm lại...phát với chả sinh...[IMG]images/smilies/a00.gif[/IMG][IMG]images/smilies/a00.gif[/IMG][IMG]images/smilies/a00.gif[/IMG]
    Em cảm ơn bác nhiều...nhiều! Lần này thì chuẩn không cần chỉnh ạ! Xin lỗi bác vì lúc đầu em ko lường trước được vấn đề nên đã gây rắc rối và làm mất nhiều thời gian của bác! Chúc bác và gia đình luôn: Vui vẻ - Mạnh khỏe - Thành đạt!

  8. #8
    huynq.231 Guest
    Trích dẫn Gửi bởi hpkhuong
    Hi vọng không còn phát sinh gì nữa hén...Tôi là tôi không có thích "Phát Sinh" đâu nha. Đưa ngay từ đầu...thì không đưa lên, để làm rồi...làm lại...phát với chả sinh...[IMG]images/smilies/a00.gif[/IMG][IMG]images/smilies/a00.gif[/IMG][IMG]images/smilies/a00.gif[/IMG]


    <div class="bbcode_container">
    <div class="bbcode_description">Code:
    </div>
    </div>
    Xin lỗi! Mình là dân mới vào nghề nên ko hiểu cho lắm. Muốn dùng đoạn code kia thì phải thao tác như thế nào?

  9. #9
    doanthanhpro Guest
    Xin hỏi mấy anh, chị với cách lọc như hpkhuong nếu có nhiều hơn 4 môn thì làm sao

Quyền viết bài

  • Bạn Không thể gửi Chủ đề mới
  • Bạn Không thể Gửi trả lời
  • Bạn Không thể Gửi file đính kèm
  • Bạn Không thể Sửa bài viết của mình
  •