Tôi có file excel gồm các sheet: TKB GV và Trích lọc lớp dạy. Tôi cần trích lọc những lớp được phân công giảng dạy của mỗi GV từ sheet TKB GV vào sheet Trích lọc lớp dạy như mẫu trong file đính kèm . Nhờ các Anh/Chị giúp đỡ cách thực hiện. Trân trọng cảm ơn!
Trích lọc lớp dạy của GV từ thời khóa biểu
- Thread starter ninhnhs
- Ngày gửi
HUONGHCKT
Zalo 0986997214
- Tham gia
- 30/8/12
- Bài viết
- 1,708
- Được thích
- 3,052
- Donate (Paypal)
- Donate (Momo)
- Giới tính
- Nam
Hỏi bạn:
Những môn : Địa_tn; LýHóa-Hóa_tt, Anh_tt, SửAnh-Anh_tt,... là những môn gì vậy?
Và có được liệt kê vào cột B của sheet (Trích lọc lớp dạy) không?
Hóa_tt; Lý_tt ..... là Hóa tăng tiết; Lý tăng tiết. Tất cả các môn có mặt trong TKB đều cần trích lọc. Nếu được Anh trích giúp môn chính khóa (không có đuôi _tt) vào 1 cột và trích lọc các môn còn lại vào 1 cột khác thì càng tốt ạ. Xin cảm ơn Anh!
Bài đã được tự động gộp:
Xin gửi lại file mới có chia làm 2 cột cho chính khóa và tăng tiết
Lần chỉnh sửa cuối:
Hoàng Tuấn 868
Đăng ký hôm qua
- Tham gia
- 9/11/19
- Bài viết
- 5,756
- Được thích
- 5,521
Cấu trúc này chắc còn điều chỉnh nhiều, các chỗ viết tắt tên môn học mỗi chỗ một kiểu thế này người thì hiểu được chứ máy không hiểu nổi.
HUONGHCKT
Zalo 0986997214
- Tham gia
- 30/8/12
- Bài viết
- 1,708
- Được thích
- 3,052
- Donate (Paypal)
- Donate (Momo)
- Giới tính
- Nam
Nếu ưng dùng VBA thì Thử xem file dưới đây trong khi chờ các giải pháp khác.
cứ tạm thế đã.
Bạn chủ thớt nên xem lại bài #4 để sửa lại dữ liệu.
Dữ liệu xuất ra từ phần mềm xếp TKB nên tên môn học có sự thống nhất trong cách đặt tên. Có thể ở các lớp ghép môn thì có sự khác nhau. Ví dụ: : Tên 12A02_SửAnh-Sử_tt chia làm 2 nhóm, ngăn cách nhau bằng gạch giữa như sau: nhóm 1: 12A02_SửAnh xem như là tên lớp (lớp con của lớp 12A02), gồm những HS trong lớp 12A02 chọn 2 môn Sử và Anh để học tăng tiết; nhóm 2: Sử_tt là tên môn học (Sử_tt là môn Sử tăng tiết). Nên tóm lại, trong cột TKB của mỗi GV, trích tất cả các lớp-môn và nếu có nhiều lớp-môn trùng nhau thì chỉ trích 1 giá trị.
Bài đã được tự động gộp:
Dạ. Coi phần trích bằng VBA vẫn còn một số chỗ bị sai ạ. Anh xem lại giúp. Chân thành cảm ơn sự giúp đỡ của Anh!
Hoàng Tuấn 868
Đăng ký hôm qua
- Tham gia
- 9/11/19
- Bài viết
- 5,756
- Được thích
- 5,521
Nếu vậy thì việc sử lý dữ liệu các công đoạn tiếp theo sẽ phức tạp hơn nhiều.
Có lẽ biến Key bạn chưa giải phóng nên có thể giá trị cuối của cột tính toán trước bị nối vào kết quả của cột kế tiếp.
Cột Dũng-AV thấy có hiện tượng này
Rút lại bài vì sai nội dung...
Lần chỉnh sửa cuối:
bebo021999
Thành viên gạo cội
- Tham gia
- 26/1/11
- Bài viết
- 5,939
- Được thích
- 8,723
- Giới tính
- Nam
- Nghề nghiệp
- GPE
Làm lại trên file của bạn HUONGHCKT nhưng xài code khác nhé
PHP:
Option Explicit
Sub TKB()
Dim i&, j&, lr&, k&, tt As String, ck As String
Dim rng, res()
Dim dic As Object, key
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("TKB GV")
lr = .Cells(Rows.Count, 3).End(xlUp).Row
rng = .Range("C2:CT" & lr).Value
End With
ReDim res(1 To UBound(rng, 2) - 3, 1 To 4)
For j = 4 To UBound(rng, 2)
k = k + 1: ck = "": tt = ""
res(k, 1) = rng(2, j): res(k, 4) = rng(1, j)
For i = 3 To UBound(rng) - 1
If rng(i, j) <> "" Then
If Not dic.exists(rng(i, j)) Then dic.Add rng(i, j), ""
End If
Next
For Each key In dic.keys
Select Case Right(key, 2)
Case "tt"
tt = IIf(tt = "", "", tt & ", ") & key
Case Else
ck = IIf(ck = "", "", ck & ", ") & key
End Select
Next
dic.RemoveAll
res(k, 2) = ck: res(k, 3) = tt
Next
If k > 0 Then
Sheet2.Activate
Range("A2").Resize(1000, 4).ClearContents
Range("A2").Resize(k, 4) = res
End If
MsgBox " Xong"
End SubHUONGHCKT
Zalo 0986997214
- Tham gia
- 30/8/12
- Bài viết
- 1,708
- Được thích
- 3,052
- Donate (Paypal)
- Donate (Momo)
- Giới tính
- Nam
Tôi có giải phóng dic rồi mà. Set dic=nothing
"Biến" Key, không phải Key của dictionary. Là biến nhé bạn
Code của bạn lưu giá trị của biến Key của lần tính trước. Khi sang cột kế tiếp, tại dòng trống dầu tiên, Dic mới của bạn sẽ nạp Key cũ vào Dic
Bạn phải liên hệ với người sử dụng cái phần mềm kia, trích xuất dữ liệu sao cho nó dễ dùng viws bảng tính môt chút (spreadsheet friendly). Nếu không thì vấn đề của bạn càng lúc sẽ càng nhiều. Cớ trình độ phải nhờ viết code từ a đến z thì nhờ cả đời.
HUONGHCKT
Zalo 0986997214
- Tham gia
- 30/8/12
- Bài viết
- 1,708
- Được thích
- 3,052
- Donate (Paypal)
- Donate (Momo)
- Giới tính
- Nam
Ồ, Tôi nhầm.
Cảm ơn Anh đã nhắc nhở chỉ bảo.
Có lẽ thay cũng không khó : Sau khi set dic =nothing thì thêm Key= Empty. có khi ổn anh nhỉ? Tôi đã xóa file nên không thử lại được.
HUONGHCKT
Zalo 0986997214
- Tham gia
- 30/8/12
- Bài viết
- 1,708
- Được thích
- 3,052
- Donate (Paypal)
- Donate (Momo)
- Giới tính
- Nam
Sai ở chỗ nào? Có phải chỗ mà bài #8 nói dến không? Nếu đúng thì thử thay Code cũ bằng code này (thêm dòng Key=Empty vào cuối vòng lặp For j ..next)
Mã:
Option Explicit
Sub TKB()
Dim i&, j&, lr&, t&, k&, m&, R, C&
Dim Arr(), KQ
Dim Dic As Object, Key
Dim Sh As Worksheet, Ws As Worksheet
Set Sh = Sheets("TKB GV")
lr = Sh.Cells(Rows.Count, 3).End(xlUp).Row
Arr = Sh.Range("C3:CT" & lr).Value
R = UBound(Arr): C = UBound(Arr, 2)
ReDim KQ(1 To C, 1 To 4)
For j = 2 To C
t = t + 1
KQ(t, 1) = Arr(1, j)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 2 To R
If Arr(i, j) <> Empty Then
k = k + 1: KQ(t, 4) = k
Key = Arr(i, j)
End If
If Not Dic.Exists(Key) Then
m = m + 1: Dic.Add (Key), m
If InStr(1, Key, "_") = 0 Then
If KQ(t, 2) = Empty Then KQ(t, 2) = Key Else KQ(t, 2) = KQ(t, 2) & ", " & Key
Else
If KQ(t, 3) = Empty Then KQ(t, 3) = Key Else KQ(t, 3) = KQ(t, 3) & ", " & Key
End If
End If
Next i
k = 0: m = 0: Set Dic = Nothing:
Key = Empty ' ===== them dong này=======
Next j
If t Then
Set Ws = Sheet2
Ws.Range("A2").Resize(1000, 4).ClearContents
Ws.Range("A2").Resize(t, 4) = KQ
End If
MsgBox " Xong"
End Sub
Bài viết mới nhất
- Question
- Đã giải quyết
