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