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

nhunguyet0103 · 4/3/16

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!

nhunguyet0103 · 4/3/16

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

hpkhuong · 7/3/16

nhunguyet0103 đã viết:
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

nhunguyet0103 · 7/3/16

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!

chuot0106 · 7/3/16

nhunguyet0103 đã viết:
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é!!!!!!!!!!!!!!!!!!!!!!!!

hpkhuong · 7/3/16

nhunguyet0103 đã viết:
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... $:=\+$ $:=\+$ $:=\+$

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

nhunguyet0103 · 7/3/16

hpkhuong đã viết:
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... $:=\+$ $:=\+$ $:=\+$

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!

tongiagia · 14/4/16

hpkhuong đã viết:

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... $:=\+$ $:=\+$ $:=\+$

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

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?

nguyenconghung101081 · 6/5/16

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

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

nhunguyet0103

Thành viên chính thức

File đính kèm

nhunguyet0103

Thành viên chính thức

hpkhuong

######

nhunguyet0103

Thành viên chính thức

File đính kèm

chuot0106

Thành viên gắn bó

File đính kèm

hpkhuong

######

nhunguyet0103

Thành viên chính thức

tongiagia

Thành viên mới

nguyenconghung101081

Thành viên mới

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

Facebook

Group

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng