từ danh sách đóng tiền lọc ra làm danh sách thi (3 người xem)

[thevu01]

Mình chỉ nắm được căn bản của excel và không biết gì về code, mong được sự hướng dẫn và giúp đỡ của các bạn.
thứ nhất:
ở sheet1 là danh sách sinh viên đóng tiền môn học. Mình muốn hỏi làm cách nào để khi mình đánh dấu "X" vào chỗ môn học thì ở các sheet tương ứng sẽ tự động cập nhật vào. Ví dụ khi đánh dấu X vào ô Toán cc ở sheet1 thì mssv họtên ngày sinh của SV ở dòng đó sẽ tự động được thêm vào chỗ mssv họtên ngày sinh ở sheet Toan cc.
thứ hai:
Ví dụ ở sheet k1 và sheet k2 là danh sách sinh viên của khóa 1 và khóa 2, có mssv họtên ngày sinh chính xác nhất. Mình muốn nhờ các bạn giúp sao cho khi nhập mssv vào sheet1 thì sẽ tự động hiển thị họ tên và ngày sinh của sinh viên đó ở sheet k1 và sheet k2 vào cột họtên ngày sinh trong sheet1, bởi vì khi nhập từng người sẽ rất dễ sai sót.
thứ ba:
Mình muốn hỏi làm cách nào để insert hay xóa mssv họtên ngày sinh của một sinh viên mớivào tất cả các sheet trong 1file trong 1 lượt, chứ nếu file có khoảng 30 sheet mà cứ copy vào từng sheet thì bất tiện quá. Quan trọng ở đây là thêm 1 dòng mới hoặc xóa đi 1 dòng cũ luôn để không làm thay đổi dữ liệu có sẵn trong sheet đó nha.
Mình có gửi kèm theo file danh sách đóng tiền. Rất mong được sự hướng dẫn và giúp đỡ của các bạn nha.View attachment DANH SACH SV DONG TIEN.xls

 

[ChanhTQ@]

Mới làm câu 1 cho bạn thôi, vì lí do sau:

Chắc bạn mới quen với CSDL, nên mình xin góp ý những gì mà nhiều người khác hay làm:
* Tên các sheets không nên để khoảng trắng, không nên có từ tiếng việt, nên ngắn gọn nhưng đủ rõ nghĩa nhất có thể (Nồng độ chuyển tải thông tin)
* Trong các CSDL, người ta không để các dòng trống trên cùng làm chi cả
Cũng trong nớ, ta không nên có tiêu đề của sheets (như sheet1 của bạn là 1 ví dụ xấu). Đây là CSDL, không phải là sheet dùng để báo cáo hay in ấn; Mọi việc cần tách bạch đễ đỡ gặp rắc rối fát sinh về sau
* Không bao giờ người ta nhập "Tổng cộng" vô dòng cuối của CSDL, nhất là 4 ô đầu như CSDL của bạn;
* . . .
Bỡi lẽ mình muốn bạn đúng ngay từ đầu, mới góp ý làm vậy; Có gì phiền lòng bỏ quá cho mình.
Xin xem thêm trong file đính kèm:

Chú ý khi khảo sát: SoSV đang được ấn định là 999, điều này có thể thay đổi bỡi bạn cho phù hợp. (Tất nhiên cũng có cách khác mà chúng ta đỡ bận tâm về sỉ số SV, nhưng chưa đến lúc)

Option Explicit
Const SoSV As Integer = 999
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Range("F5:I" & SoSV), Target) Is Nothing Then
    Dim ShName As String
    Dim Rng As Range
    ShName = Choose(Target.Column - 5, "Toan", "PLDC", "TLy", "Triet", "Sheet3")
    Set Rng = Cells(Target.Row, "B").Resize(, 3)
    Sheets(ShName).[B65500].End(xlUp).Offset(1).Resize(, 3).Value = Rng.Value
 End If
End Sub

Thân ái!

 

[thevu01]

- Mình không có phiền lòng gì hết ngược lại cảm ơn bạn rất nhiều. Như đã nói ngay từ đầu mình chỉ nắm được phần căn bản của excel thôi, được bạn góp ý mình rất vui và mong sẽ được các bạn chỉ dẫn nhiều hơn nữa. Bạn ChanhTQ thấy trong file dữ liệu của mình còn những vấn đề nào không phù hợp nữa bạn hãy hướng đẫn và có thể thì sửa lại giùm mình cho phù hợp luôn nha để mình rút kinh nghiệm.
- Mà bạn ơi cái bạn mới làm giùm mình quả thật đánh dấu X vào thì ở sheet tương ứng có tên thật, nhưng mà bỏ dấu X hoặc thay dấu X thay bằng ký tự khác thì cũng thêm tên đó luôn, có cách nào đánh dấu X thì có tên đó ở sheet tương ứng bỏ dấu X thì mất tên đó không bạn? Tại vì mình căn cứ theo danh sách đóng tiền để làm danh sách thi đó bạn. Mà mình để họ chữ lót và tên ở 2 cột không được hả bạn? tại vì như vậy mình mới tìm và sắp xếp thứ tự ABC theo tên được.
- Vấn đề của mình là nhập chính xác danh sách sinh viên đóng tiền từ biên lai, từ danh sách đó lọc ra làm danh sách thi, sinh viên đóng tiền môn nào sẽ có tên trong danh sách thi môn đó và phải chính xác mssv họtên ngày sinh so với danh sách gốc, nếu như không có trong danh sách gốc thì phải biết để tách riêng ra. Mỗi lần khoảng vài trăm sinh viên và khoảng 20 môn thi, làm thủ công rất dễ sai sót lại rất tốn thời gian nên các bạn có cách nào hay hoặc có phần mềm nào giải quyết được các vấn đề của mình thì share cho mình với, mình cảm ơn rất nhiều.

 

[ChanhTQ@]

Có cách nào đánh dấu X thì có tên đó ở sheet tương ứng bỏ dấu X thì mất tên đó không bạn?

Phần yêu cầu này mình đã viết trong file dưới đây; (Đoạn code trước dòng lệnh được ghi số 2)
Bạn thử nghiệm lại xem sao?!
Lưu ý: Nếu chọn trên 2 ô trong khu vực thì sẽ thoát
File bài trên không xài được nữa, bỡi bạn lại nhập mã SV trùng nhau trong sheet1. Điều này làm mất thời gian không đáng tối qua để tìm ra sai sót của hai chúng ta đó!
Phần sau câu lệnh 2 là thỏa mãn yêu cầu thứ hai #1 của bạn;
Nhưng ở đây cần góp ý với bạn các vấn đề sau:
* CSDL góc phải là sheet1
* Mà trong đó cần tách họ đệm riêng 1 trường, [Ten] riêng một trường
(Chỉ khi ra báo cáo mới gộp chung chúng lại để in ấn & . . . )
* Trong CSDL này thêm 1 trường [Khoa] đễ lưu giữ khóa (niên học?)
* Để tránh việc nhập trực tiếp vô CSDL này gây sai sót thường xuyên, bạn cần có sheet nhập liệu riêng. (Chúng ta cùng với bạn sẽ bàn sau!)

Option Explicit
Const SoSV As Integer = 999
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Rng As Range, sRng As Range
 Dim Jj As Byte:            Dim ShName As String
 
1 If Not Intersect(Range("G5:J" & SoSV), Target) Is Nothing Then
    If Target.Cells.Count >= 2 Then     Exit Sub
     ShName = Choose(Target.Column - 6, "Toan", "PLDC", "TLy", "Triet", "Sheet3")
    Set Rng = Cells(Target.Row, "B").Resize(, 4)
    If UCase$(Target) = "X" Then
        Sheets(ShName).[B65500].End(xlUp).Offset(1).Resize(, 4).Value = Rng.Value
    ElseIf Target = "" Then
        With Sheets(ShName).Columns("B:B")
            Set sRng = .Find(what:=Rng.Cells(1, 1).Value, _
                LookIn:=xlFormulas, lookat:=xlWhole)
            sRng.EntireRow.Delete
        End With
    End If
2 ElseIf Not Intersect(Target, Range("B5:B" & SoSV)) Is Nothing Then
    For Jj = 1 To 2
        ShName = Choose(Jj, "K1", "K2")
        With Sheets(ShName).Range("A4:A" & SoSV)
            Set sRng = .Find(what:=Target.Value, LookIn:=xlFormulas, _
                lookat:=xlWhole) '
            If Not sRng Is Nothing Then _
                Target.Offset(, 1).Resize(, 3).Value = sRng.Offset(, 1).Resize(, 3).Value
        End With
    Next Jj
 End If
End Sub

Ngày đầu năm chúc bạn vui khỏe & nhiều hạnh phúc!

 

[thevu01]

Cảm ơn bạn ChanhTQ đã làm giúp mình và góp ý cho mình nhiều nha.
-Mà bạn ơi khi khảo sát SoSV được ấn định là 999 là sao vậy bạn? Nếu mình thêm sinh viên ở sheet k1 k2 thì những sinh viên mới bổ sung đó khi nhập mã số ở sheet1 có tự động hiện ra không bạn?
-Nếu số sinh viên ở k1 k2 đều lớn hơn 999 thì có sao không bạn?
-Ví dụ mình muốn thêm khoảng 10 môn học nữa ở sheet1 và thêm 10 sheet nữa thì sửa đoạn code như thê nào vậy bạn?
-Và thêm hơn rất nhiều sinh viên ở sheet k1 k2 nữa? và thêm các cột NOISINH CHUYENNGHANH, KHOA, GHUCHU ở các sheet như file đính kèm đó bạn.
Đầu năm chúc bạn ChanhTQ và tất cả các bạn vui vẻ phát tài nhá.
View attachment DSHS.rar

 

[ChanhTQ@]

-Mà bạn ơi khi khảo sát SoSV được ấn định là 999 là sao vậy bạn?
-Nếu số sinh viên ở k1 k2 đều lớn hơn 999 thì có sao không bạn?

Bạn sửa lại số 999 này =[Tổng SV]+ a (a là số bất kỳ bạn muốn - nên là 99)
Số a này làm bạn ít sửa lại SoSV mà thôi;
Hay thế này cũng được: Hàng năm trường bạn nhận vô 1.200 SV; năm nằm là 6.000;
Vậy ta ấn định SoSV = 12.000 (trừ hao số lưu ban) - Khi đó số tốt nghiệp sau 1 năm sẽ chuyển hồ sơ sang file khác để lưu.
Cũng nói trước rằng, sẽ có cách đối phó tốt nhất với SoSV này, đừng ấy náy nhiều về nó; Hiện thời cứ cho dư lên 1 tí
Một điều nữa xin góp ý: Nếu bạn vẫn giữ 2 sheets K1 & K2 thì nên gộp chung chúng lại; Mình đã thấy có trường [Khoa] ở cả 2 sheets rồi mà. (Nếu [Khoa] không phải biểu hiện của í nghĩa của k1 hay K2 thì nên thêm 1 trường nửa trong 1 sheet vẫn lợi hơn để 2 sheets như vậy. Theo mình cấu trúc nặng hơn nhiều khi để như thế!)

-Ví dụ mình muốn thêm khoảng 10 môn học nữa ở sheet1 và thêm 10 sheet nữa thì sửa đoạn code như thê nào vậy bạn?

Đoạn lệnh cần sửa là:

ShName = Choose(Target.Column - 6,"Toan", "PLDC", "TLy", "Triet", "Sheet3")

Hàm Choose này cho phép 29-30 trường gì đó, nhớ không kỹ lắm; Nhưng nếu >30 vẫn có cách #, chớ bận tâm nhiều! Lưu ý tên các sheets cho đồng nhất với tên các trường

Nếu mình thêm sinh viên ở sheet k1 k2 thì những sinh viên mới bổ sung đó khi nhập mã số ở sheet1 có tự động hiện ra không bạn?

Chuyện này chúng ta bàn sau, một khi ta thống nhất được với nhau về (nói cho to tác cấu trúc các sheets chứa dữ liệu!
Còn đưa ra các dòng lệnh sau dòng được đánh số 2 nêu trên chỉ muốn nói rằng Viết thì viết được, chú không phải không; Nhưng vẫn khuyên bạn lo chuyện nền tảng - cấu trúc dữ liệu xong cái đã!

Thân mến!!

 

[thevu01]

-Tại mình làm bên đào tạo từ xa nên mình muốn để 2 sheets k1 k2 thực chất là 1 cái tại trường và 1 cái ở nơi khác, tại vì những sinh viên ở cơ sở khác của trường đến chỗ mình đăng ký học và thi môn nào đó vẫn được, nhưng mình phải biết để tách ra làm danh sách riêng, về phần này mình cũng đang đau đầu vì mỗi lần phải tách thủ công tốn thời gian quá.

-Đoạn lệnh này:
PHP Code:
ShName = Choose(Target.Column - 6,"Toan", "PLDC", "TLy", "Triet", "Sheet3")
mình có thử thêm vào mấy sheet nữa, ghi giống hệt tên sheets có dấu " " nhưng mà không có hoạt động hic..hic chắc tại minh không biết về code nên không biết cách sửa

-Bây giờ minh gửi bạn file có 25 môn học, bạn làm giúp mình theo thứ tự mh1 - mh25 nha có gì sau này mình sẽ thay đổi tên nha. Mình có thêm vào ở sheet1 mấy cột đầu để dễ quản lý đó. Bạn mặc định giùm mình SoSv càng nhiều càng tốt giùm luôn nha, tốt nhất là không còn bận tâm về SoSv nữa, tại vì số sinh viên ở 2 sheet taiday va noikhac mình phải cập nhật thường xuyên. Bạn thấy có chỗ nào không phù hợp thì cứ góp ý giùm mình và nếu được hãy sửa giùm luôn nha để có nền tảng về cơ sở dữ liệu tốt nhất, mình sẽ dùng để làm việc luôn. Thank bạn ChanhTQ@ trước nha

 

[ChanhTQ@]

Bạn hãy tham khảo & thử nghiệm

Option Explicit
Const SoSV As Integer = 10999
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Rng As Range, sRng As Range
 Dim Jj As Byte:            Dim ShName As String
 If Target.Cells.Count >= 2 Then Exit Sub
 If Not Intersect(Range("Q3:AO" & SoSV), Target) Is Nothing Then
    ShName = Choose(Target.Column - 16, "mh1", "mh2", "mh3", "mh4", "mh5", "mh6", _
    "mh7", "mh8", "mh9", "mh10", "mh11", "mh12", "mh13", "mh14", "mh15", "mh16", _
    "mh17", "mh18", "mh19", "mh20", "mh21", "mh22", "mh23", "mh24", "mh25")
    Set Rng = Cells(Target.Row, "F").Resize(, 7)
    If UCase$(Target) = "X" Then
        Sheets(ShName).[B65500].End(xlUp).Offset(1).Resize(, 7).Value = Rng.Value
    ElseIf Target = "" Then
        With Sheets(ShName).Columns("B:B")
            Set sRng = .Find(what:=Rng.Cells(1, 1).Value, _
                LookIn:=xlFormulas, lookat:=xlWhole)
            sRng.EntireRow.Delete
        End With
    End If
 ElseIf Not Intersect(Target, Range("F3:F" & SoSV)) Is Nothing Then
    For Jj = 1 To 2
        ShName = Choose(Jj, "taiday", "noikhac")
        With Sheets(ShName).Range("B2:B" & SoSV)
            Set sRng = .Find(what:=Target.Value, LookIn:=xlFormulas, _
                lookat:=xlWhole) '
            If Not sRng Is Nothing Then _
                Target.Offset(, 1).Resize(, 7).Value = sRng.Offset(, 1).Resize(, 7).Value
        End With
    Next Jj
 End If
End Sub

Tại "mh1", cột 'A' mình có thiết lập CT: =IF(B3="","",ROW()-2)
Nếu thấy xài được, thì . . . . hì hì

 

[volga]

Bạn có thể làm bằng công thức cho mình tham khảo không ?VBA mình mù tịt ...

 

[SA_DQ]

Bạn có thể làm bằng công thức cho mình tham khảo không ?VBA mình mù tịt ...

Một ngàn sinh viên trở lên mà làm công thức là điều không nên; Mình xin can bạn đó!
Trước lạ sau quen, Bạn theo hướng dẫn trên diễn đàn để tiếp cận dần với VBA đi;
Tuổi trẻ tài cao mà, hãy chinh phục VAB như những người khác đã chinh fục!

(húc /)/(ừng )(uân /(/)ới!!

 

[thevu01]

Thank bạn ChanhTQ@ nha, bây giờ như vầy là quá tốt rồi minh sẽ thử nghiệm có sinh ra vấn đề gì nữa mình sẽ nhờ bạn nữa nha.

 

[thevu01]

Bạn ChanhTQ@ sheet QLHS và THESV không hoạt động rùi, mình thử thêm vào trong code là không hoạt động toàn bộ luôn híc... Với lại khi delete các dấu X liên tục là nó báo lỗi ngay đoạn code này sRng.EntireRow.Delete. Với lại có cách nào tự động cập nhật từ sheet taiday và noikhac không bạn, tại vì nhiều lúc có thể bổ sung một số thông tin vào 2 sheet đó mà dò lại bên sheet1 ở đâu thì lâu quá.

Với lại có thể làm sao để thêm dấu X và xóa dấu X hàng loạt không bạn, tại vì nếu bôi đen 1 khối và xóa đi hoặc thêm thì nó không hiểu. Bạn làm giúp mình nha.

 

[ChanhTQ@]

Bạn ChanhTQ@:
1* Sheet QLHS và THESV không hoạt động rùi, mình thử thêm vào trong code là không hoạt động toàn bộ luôn híc...
2* Với lại khi delete các dấu X liên tục là nó báo lỗi ngay đoạn code này sRng.EntireRow.Delete.
3* Với lại có cách nào tự động cập nhật từ sheet taiday và noikhac không bạn, tại vì nhiều lúc có thể bổ sung một số thông tin vào 2 sheet đó mà dò lại bên sheet1 ở đâu thì lâu quá.
2'*Với lại có thể làm sao để thêm dấu X và xóa dấu X hàng loạt không bạn, tại vì nếu bôi đen 1 khối và xóa đi hoặc thêm thì nó không hiểu.
Bạn làm giúp mình nha.

Bạn ơi, nhiều việc quá đối với mình đó!
Mình chỉ có thể giúp bạn từng fần theo những câu đề nghị trên mà thôi!
Trong 4 fần việc trên, bạn muốn bắt đầu từ fần nào?
Với C3: Mình nói rồi, ta sẽ thực hiện việc nhập & sửa dữ liệu bằng 1 sheetForm hay trong tương lai, là 1 Form nhập liệu hẵn hoi; Nhưng trong trường hợp II này, bạn phải có 1 vốn đối ứng nhất định để vận hành nó. .. .
Với C1* 2 sheets đang không hoạt động, vậy bạn rõ nghĩa hơn xem, chúng sẽ phải hoạt động như thế nào?
. . . . .

Nếu bạn không chờ mình được & nóng lòng muốn đứa con này của bạn fụ giúp ngay cho bạn vô công việc trong học kỳ tới, Bạn thử liên hệ với Admin; Admin sẽ tìm nhóm chuyên gia trên GPE.COM sẽ xử lý ngay các yêu cầu của bạn theo thỏa thuận.
Thân ái!

 

[thevu01]

Ah...với C1 thì 2 sheet đó cũng giống như các sheet mh1 đến mh25 vậy thôi hà. Đánh dấu X thì có tên trong sheet đó bạn.

Uhm đúng là mình chưa hiểu nhiều về excel nên chưa có vận hành tốt được, nếu được mong bạn chỉ dẫn thêm cho mình nha.

Mình cũng không có nóng lòng đưa nó vào sử dụng ngay đâu, trước mắt bạn giúp được phần nào cũng được. Cứ từ từ để hoàn thiện nó, bạn chịu giúp là mình vui rồi.

Nếu được thêm các bạn admin giúp đỡ thì tốt quá nhưng mà mình đâu biết liên lạc thế nào, chỉ biêt post lên hỏi các bạn thôi. Rất mong được sự giúp đỡ của các bạn!!!

 

[ChanhTQ@]

Bạn xem thử câu I đúng ý chưa nha

Ah...với C1 thì 2 sheet đó cũng giống như các sheet mh1 đến mh25 vậy thôi hà. Đánh dấu X thì có tên trong sheet đó bạn.
Uhm đúng là mình chưa hiểu nhiều về excel nên chưa có vận hành tốt được, nếu được mong bạn chỉ dẫn thêm cho mình nha!

Chú ý: Các dòng lệnh được đánh số đã đổi khác để thực thi yêu cầu I của bạn;
Bạn copy macro dưới & chép đè lên macro đang hiện diện trong file của bạn!

 Option Explicit
Const SoSV As Integer = 11999
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Rng As Range, sRng As Range
 Dim Jj As Byte:            Dim ShName As String
 If Target.Cells.Count >= 2 Then Exit Sub
1 If Not Intersect(Range("O3:AO" & SoSV), Target) Is Nothing Then '*'
2    ShName = Choose(Target.Column - 14, "QLHS", "THESV", "mh1", "mh2", "mh3", "mh4", _
    "mh5", "mh6", "mh7", "mh8", "mh9", "mh10", "mh11", "mh12", "mh13", "mh14", "mh15" _
    , "mh16", "mh17", "mh18", "mh19", "mh20", "mh21", "mh22", "mh23", "mh24", "mh25")
    Set Rng = Cells(Target.Row, "F").Resize(, 7)
    If UCase$(Target) = "X" Then
        Sheets(ShName).[B65500].End(xlUp).Offset(1).Resize(, 7).Value = Rng.Value
    ElseIf Target = "" Then
        With Sheets(ShName).Columns("B:B")
            Set sRng = .Find(Rng.Cells(1, 1).Value, LookIn:=xlFormulas, lookat:=xlWhole)
            sRng.EntireRow.Delete
        End With
    End If
 ElseIf Not Intersect(Target, Range("F3:F" & SoSV)) Is Nothing Then
    For Jj = 1 To 2
        ShName = Choose(Jj, "taiday", "noikhac")
        With Sheets(ShName).Range("B2:B" & SoSV)
            Set sRng = .Find(what:=Target.Value, LookIn:=xlFormulas, lookat:=xlWhole)                 '
            If Not sRng Is Nothing Then _
                Target.Offset(, 1).Resize(, 7).Value = sRng.Offset(, 1).Resize(, 7).Value
        End With
    Next Jj
 End If
End Sub

 

[ChanhTQ@]

Với lại có thể làm sao để thêm dấu X và xóa dấu X hàng loạt không bạn, tại vì nếu bôi đen 1 khối và xóa đi hoặc thêm thì nó không hiểu. Bạn làm giúp mình nha.

Xóa nguyên 1 cột thì sắp xong, hãy đợi đấy!
Thêm nguyên 1 cột thì mới mường tượng, cũng hãy đợi đấy!
Thêm hay xóa nhiều cột thì chưa nghĩ tới.

 

[thevu01]

Ok thank bạn nhiều nha

 

[ChanhTQ@]

Thêm & xóa nguyên 1 cột đây, xin mời!

Option Explicit
Const SoSV As Integer = 11999
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Rng As Range, sRng As Range, Clls As Range
 Dim Jj As Byte:                                Dim ShName As String
 
 If Not Intersect(Range("O3:AO" & SoSV), Target) Is Nothing Then
    Application.ScreenUpdating = False
    ShName = Choose(Target.Column - 14, "QLHS", "THESV", "mh1", "mh2", "mh3", "mh4", _
    "mh5", "mh6", "mh7", "mh8", "mh9", "mh10", "mh11", "mh12", "mh13", "mh14", "mh15" _
    , "mh16", "mh17", "mh18", "mh19", "mh20", "mh21", "mh22", "mh23", "mh24", "mh25")
    If Target.Cells(1, 1) = "" Then             'Delete more than record'
        For Each Clls In Target
            Set Rng = Cells(Clls.Row, "F").Resize(, 7)
            With Sheets(ShName).Columns("B:B")
                Set sRng = .Find(Rng.Cells(1, 1).Value, _
                    LookIn:=xlFormulas, lookat:=xlWhole)
                If Not sRng Is Nothing Then sRng.EntireRow.Delete
            End With
        Next Clls
    ElseIf UCase$(Target.Cells(1, 1)) = "X" Then            'Add Records to Sheet'
        For Each Clls In Target
            Sheets(ShName).[B65500].End(xlUp).Offset(1).Resize(, 7).Value _
                = Cells(Clls.Row, "F").Resize(, 7).Value
        Next Clls
    End If
 ElseIf Not Intersect(Target, Range("F3:F" & SoSV)) Is Nothing Then
    For Jj = 1 To 2
        ShName = Choose(Jj, "taiday", "noikhac")
        With Sheets(ShName).Range("B2:B" & SoSV)
            Set sRng = .Find(what:=Target.Value, LookIn:=xlFormulas, lookat:=xlWhole)                 '
            If Not sRng Is Nothing Then _
                Target.Offset(, 1).Resize(, 7).Value = sRng.Offset(, 1).Resize(, 7).Value
        End With
    Next Jj
 End If
End Sub

 

[ChanhTQ@]

. . . Với lại có cách nào tự động cập nhật từ sheet taiday và noikhac không bạn, tại vì nhiều lúc có thể bổ sung một số thông tin vào 2 sheet đó mà dò lại bên sheet1 ở đâu thì lâu quá.

Bạn giải thích rõ hơn hai câu này xem sao? Cập nhật từ (1) & (2) đến Sheet1 hay ngược lại?
Hay bạn cần nhập & sửa ở (1) & (2). Điều cuối này mình nói rồi, sau Tết đi! Còn bây chừa chỉ làm rõ vấn đề mà thôi; Chúc xuân vui vẽ!

Sau đây là đoạn Code tách ra từ bài trên liền kề; Mục đích để làm tiền đề xóa hay nhập vô nhiều sheets môn học cùng lúc; Bạn có thểtham khảo trước.

Option Explicit
Dim sRng As Range:                          Dim ShName As String
Private Sub Worksheet_Change(ByVal Target As Range)
 Const SoSV As Integer = 11999:             Dim Jj As Byte
 
 If Not Intersect(Range("O3:AO" & SoSV), Target) Is Nothing Then
    Application.ScreenUpdating = False
 
   DeleteAndAddRecords Target
 
 ElseIf Not Intersect(Target, Range("F3:F" & SoSV)) Is Nothing Then
    For Jj = 1 To 2
        ShName = Choose(Jj, "taiday", "noikhac")
        With Sheets(ShName).Range("B2:B" & SoSV)
            Set sRng = .Find(what:=Target.Value, LookIn:=xlFormulas, lookat:=xlWhole)                 '
            If Not sRng Is Nothing Then _
                Target.Offset(, 1).Resize(, 7).Value = sRng.Offset(, 1).Resize(, 7).Value
        End With
    Next Jj
 End If
End Sub

[B]Sub DeleteAndAddRecords(Target As Range)[/B]
 Dim Clls As Range, Rng As Range
 
 ShName = Choose(Target.Column - 14, "QLHS", "THESV", "mh1", "mh2", "mh3", "mh4", _
    "mh5", "mh6", "mh7", "mh8", "mh9", "mh10", "mh11", "mh12", "mh13", "mh14", "mh15" _
    , "mh16", "mh17", "mh18", "mh19", "mh20", "mh21", "mh22", "mh23", "mh24", "mh25")
 If Target.Cells(1, 1) = "" Then             [COLOR=blue]'Delete more than record'[/COLOR]
    For Each Clls In Target
        Set Rng = Cells(Clls.Row, "F").Resize(, 7)
        With Sheets(ShName).Columns("B:B")
            Set sRng = .Find(Rng.Cells(1, 1).Value, _
                LookIn:=xlFormulas, lookat:=xlWhole)
            If Not sRng Is Nothing Then sRng.EntireRow.Delete
        End With
    Next Clls
 ElseIf UCase$(Target.Cells(1, 1)) = "X" Then           [COLOR=blue]'Add Records to Sheet'[/COLOR]
    For Each Clls In Target
        Sheets(ShName).[B65500].End(xlUp).Offset(1).Resize(, 7).Value _
            = Cells(Clls.Row, "F").Resize(, 7).Value
    Next Clls
 End If
[B]End Sub[/B]

 

[thevu01]

Là thêm vào hoặc sửa chữa ở 2 sheet taiday và noikhac, rồi tự động được cập nhật ở sheet1 đó bạn. Uhm cảm ơn bạn nhiều nha, chúc bạn ăn tết vui vẻ nha.