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

Liên hệ QC

Người dùng đang xem chủ đề này

thevu01

Thành viên mới
Tham gia
30/12/08
Bài viết
48
Được thích
14
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 sinhsheet Toan cc.
thứ hai:
Ví dụ ở sheet k1sheet 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 k1sheet 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
 
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)

PHP:
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!
 
Lần chỉnh sửa cuối:
- 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.:-=:-=
 
Lần chỉnh sửa cuối:
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!)


PHP:
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!
 

File đính kèm

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
 
Lần chỉnh sửa cuối:
-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à:
PHP:
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!!:-=
 
-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:-=:-=
 

File đính kèm

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

PHP:
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ì
 

File đính kèm

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 ...
 
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!!
 
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.
 
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.
 
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!}}}}}
 
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!!!
 
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!


PHP:
 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
 
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.
:-= --=0 -+*/ __--__
 
Thêm & xóa nguyên 1 cột đây, xin mời!

PHP:
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
--=0 :-=
 
. . . 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.

PHP:
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
Mã:
[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]
 

File đính kèm

Lần chỉnh sửa cuối:
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.
 
Uhm qua tết bạn xem giùm mình luôn sao khi insert thêm hay xóa đi khoảng 5 dòng thì nó báo lỗi ngay đoạn này nha: ;;;;;;;;;;; ;;;;;;;;;;; %#^#$ :-=
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")
 
Lần chỉnh sửa cuối:
Xin góp í với bạn về tiết kiệm tài nguyên trong CSDL.

Thứ nhất: Đó là mã SV
Hiện tại của bạn đang là: 19QT09A001 cho đến 19QT09A1954
+ Độ dài của mã phải bằng nhau trong tất cả các records! (Vì sao ư, chuyện dài lắm đó . . . )
+ 09 có lẽ biểu thị năm học? Nếu vậy dùng 2 ký tự là dư, Sao ta không dùng chỉ 1 ký tự?
Ví dụ năm 2010 biểu thị bằng chữ 'A'; 2012 là 'C', . . . . Và như vậy chúng ta còn xài trên 26 năm nữa mới hết kho dự trữ. Hơn nữa, đến lúc đó (2036) chương trình quản lý SV này được về hưu rồi cũng nên!
Với dữ liệu độ 10.000 records thì bạn đã tiết kiệm được bao nhiêu rồi ấy chứ!
+ Cho phép được hỏi sâu thêm 1 chút, 19QT là gì vậy? Nếu rõ về ý nghĩa của cụm này, chúng ta có thể rút ngắn lại, nhằm đỡ ì ạch sau này khi đưa CSDL vô hoạt động.
Thứ hai: Đó là mã tỉnh
Bạn nên lập danh sách về mã tỉnh riêng, ví du:
|A|B|
|Ma|TTinh|
|08|Tp HCM|
|60| Đồng nai|
|. . .|. . . |​
|||
như vậy mỗi SV chỉ có 2 kí tự biểu thị nơi sinh thay vì trung bình 15 ký tự như hiện nay. (Ngoài ra ở cột 'GhiChu' của bạn tôi chưa kể)
Bạn thử làm con tính về số byte bạn tiết kiệm được xem sao! Ngoài ra máy tính sẽ tìm nhanh hơn, nếu nó phải có nhiệm vụ thống kế cư dân các tỉnh trong CSDL của ta đó nha!
Một lưu í nhỏ nữa, tên trường trong CSDL không nên dùng từ Việt hay có khoảng trắng​
Thay vì như của bạn, ta nên sửa lại là: [TT], [MaSV], [Ho], [Ten], [NgaySinh], . . .
Chúc vui!​
 
Chỉnh sửa lần cuối bởi điều hành viên:
Mình xin cảm ơn những ý kiến góp ý của bạn Hyen17. Những ý bạn nói rất hợp lý nhưng mà tiếc là mình không thể thay đổi cách cho mã số được tại vì cái đó cơ quan "xếp" mình cho. Mình sẽ góp ý lên trên, với lại thông thường độ dài mã số sẽ bằng nhau vì đến 999 sẽ có chuyển qua số khác.

19QT là ký hiệu nghành học và cơ sở học đó bạn, tại vì thông thường 1 tỉnh sẽ có 2 đến 3 cơ sở lận, tại vì đào tạo từ xa mà, mình chỉ ở 1 trong những cơ sở đó thôi nhưng ở các cở sở khác đến đăng ký học và thi thì phải nhận và tách riêng ra nữa.

Về phần nơi sinh bạn nói đúng nhưng mình chỉ quản lý các sinh viên ở cơ sở mình thôi còn những nơi khác mình được ở trên chuyển xuống, bây giờ muốn thay đổi lại hết mình cũng chưa biết phải làm thế nào nữa nhưng mình sẽ nghiên cứu về chuyện đó.

Còn phần có khoảng trắng và ghi tiếng việt quả thật là do mình "gà" về CSDL, mình để vậy để tiện cho việc in ấn nhưng lần trước bạn ChanhTQ@ có góp ý cho mình một lần mình cũng đã có sữa chữa lại rồi.

Cảm ơn những ý kiến đóng góp của bạn, mong sẽ được bạn giúp đỡ và chỉ dẫn nhiều hơn. Chúc bạn luôn vui khỏe@$@!^% @$@!^% /-*+/ :-=
 
Hãy thử lại lần nữa xem sao?

. . bạn xem giùm mình luôn sao khi insert thêm hay xóa đi khoảng 5 dòng thì nó báo lỗi ngay đoạn này nha:
Bạn mở file ra; Đến sheets("TheSV") & xóa bằng tay các records trong đó!
GĐ: Thêm 1 lúc 4 records
Tiếp theo sang sheets1; tới cột 'P'
Dùng chuột chọn các ô thuộc hàng 5,6,7 & 9 (kích hoạt các ô này);
Sau đó bấm chuột lên thanh công thức; nhập ký tự 'x' hay 'X'
giữ phím {CTRL} & bấm {ENTER}
Nếu ta sang 'TheSV' thấy có 4 records thì mới sang giai đoạn sau;

GĐ2: Xóa 4 records này:
Dùng chuột kích hoạt vùng từ "P5:P9" & bấm phím {Delete} xem macro có làm điều gì không?
Nếu macro còn cự nự, báo cho GPE.COM xử lý tiếp!
 
Ý mình không phải bạn Hyen17 ơi. Khi dùng đoạn code mới nhất của bạn ChanhTQ@ thì khi insert hoặc xóa đi 5 dòng mới có nghĩa là khi copy 5 hàng ngang cũ rồi insert copies cell hoặc delete 5 hàng ngang thì báo lỗi ngay đoạn code mình nêu ở trên đó. Mình đang dùng đoan code này của bạn ChanhTQ@ nè:
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
Uh với lại bạn chỉ dùm mình chỉnh chỗ nào để cố định 1 dòng trên cùng để khi rê chuột giữa thì chỉ chạy xuống các dòng phía dưới thôi với như là file mình kèm theo nè, mình mò hoài mà không biết chỉnh chỗ nào, ban vào file rê chuột giữa là biết liền ah. Cảm ơn bạn đã giúp đỡ:-= --=0 %#^#$
 

File đính kèm

chỉ dùm mình chỉnh chỗ nào để cố định 1 dòng trên cùng để khi rê chuột giữa thì chỉ chạy xuống các dòng phía dưới thôi với như là file mình kèm theo nè, mình mò hoài mà không biết chỉnh chỗ nào, ban vào file rê chuột giữa là biết liền ah. Cảm ơn bạn đã giúp đỡ:-= --=0 %#^#$
Chọn ô A2 rồi vào Window\Freeze Panes => OKIE
 
Mình vừa đưa file lên tại bài #19

Bạn dùng file đó áp dụng theo hướng dẫn tại bài #24 xem sao!
TheVU01 ơi! Chúng ta đang bàn nhiều việc, nhưng thực hiện chỉ từng mỗi việc.
Việc thực hành macro lại đang là từ sheet1 chuyển các records đến 1 sheet môn học nào đó. Macro cuối đang là xóa hay chuyển 1 lúc nhiều records.
Hình như bạn lại hiểu ra thành vấn đề khác, đó là nhập từ (S1) & (S2) sang sheet1 & xóa các recors hay sao ấy!
Coi chừng lại chuyện: 'Ông nói gà, bà nói vịt' cũng nên!


Xin nhờ MOS/SMOD gộp bài này lên các bài trên, một khi tác giả topic đọc nó!
Xin Cảm ơn nhiều!
 
Lần chỉnh sửa cuối:
Vậy để mình nói rõ lại ý của mình nha
1. Ở 2sheet đầu tiên là taidaynoikhac, theo mình như là kho CSDL vậy đó. Ở sheet1 khi nhập MSSV vào thì sẽ lấy dữ liệu từ trong kho đó ra, nhưng cũng có đôi lúc sửa chữa lại các dữ liệu trong kho đó, nên mình muốn những dữ liệu vừa sửa chữa trong kho đó sẽ được tự động cập nhật ở sheet1 đó bạn.
2. Là phần như bạn ChanhTQ@ nói đó, từ sheet1 chuyển các records đến 1 sheet học nào đó, và có thể chuyển hoặc xóa 1 lúc nhiều records đó bạn, có thể túm lại là nếu ở cột môn học ở sheet1 có dấu X thì sinh viên đó sẽ có tên ở sheet mh tương ứng, không có dấu X thì sẽ không có tên (có thể là lúc đầu có dấu X nhưng bị xóa đi).
Uhm bạn ChanhTQ@ ơi chắc bạn đã hiểu nhầm ý của mình phần bị lỗi mới là khi dùng đoạn code mới nhất của bạn ở #18 thì khi insert hoặc xóa đi 5 dòng mới có nghĩa là khi copy 5 hàng ngang cũ rồi insert copies cell hoặc delete 5 hàng ngang thì báo lỗi ngay đoạn code
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") này đó)(&&@@)(&&@@
 
Lần chỉnh sửa cuối:
Mấy bạn đâu hết trơn rồi hic...
 
Bạn ChanhTQ@ ơi mình đang dùng đoạn code của bạn ở 318 khi insert hoặc xóa đi 5 dòng mới có nghĩa là khi copy 5 hàng ngang cũ rồi insert copies cell hoặc delete 5 hàng ngang thì báo lỗi ngay đoạn code
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").
Bạn giúp mình với
 
Bạn ơi mình đang dùng đoạn code ở #18 khi insert hoặc xóa đi 5 dòng mới có nghĩa là khi copy 5 hàng ngang cũ rồi insert copies cell hoặc delete 5 hàng ngang thì báo lỗi ngay đoạn code
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").
Bạn giúp mình với

Bạn phải viết câu có tân ngữ chứ;
Ví dụ: Khi tôi xóa đi 5 dòng bao gồm từ A4:A9 tại sheets("Sheets") . . .

Chứ bạn viết vậy, chỉ có bạn hiểu thôi & tốn thời gian cả của bạn nữa đó!

". . .khi insert hoặc xóa đi 5 dòng mới có nghĩa là khi copy 5 hàng ngang cũ rồi insert copies cell hoặc delete 5 hàng ngang thì báo lỗi ngay đoạn code . . ."
Bạn từ từ thôi, bạn Inert thì insert cái gì vô cái gì vậy?
Xóa đi 5 dòng, thì xóa 5 dòng ở trang tính nào, dòng cụ thể nào?
Copy 5 hàng cũ là copy những hàng nào đem đến đâu, chép vô đâu(?)
. . . .
Thú thật đến giờ, với mình như mới toanh vậy, quên sạch cả rồi í chứ!
Đoạn code thì đang bài #18 vậy dữ liệu bạn đang áp dụng ở bài nào vậy!

Xin chào!
 
Mình xin lỗi chắc là mình quá vội vàng và mình nhờ bạn quá nhiều việc, nhưng không hỏi trên này trên này mình cũng không biết hỏi ai nữa, mong sẽ được các bạn giúp đỡ.

Minh đang sử dụng dữ liệu trong file đính kèm đó. Khi làm việc ở sheet1 ta insert hoặc delete 1 hàng ngang bất kỳ ví dụ như hàng ngang số 3 thì nó báo lỗi "run-time error '94' Invalid use of Null", debug thì nó tô vàng ngay đoạn code 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").
Và khi ta copy 5 hàng ngang ví dụ như từ hàng ngang số 10 đến số 15 và
insert copies cell vào hàng ngang số 3 thì cũng báo lỗi như trên vậy đó.
Tại vì mình cần số liệu tổng cộng ở phía dưới nên khi nhập dữ liệu hết các hàng ngang thì mình thường phải insert thêm hàng ngang để nhập tiếp, bạn có cách nào tiện lợi hơn bạn chỉ giúp mình với. Cảm ơn bạn rất nhiều@$@!^%@$@!^%:-=
 

File đính kèm

Lần chỉnh sửa cuối:
Tạm thời bạn thêm vài dòng lệnh như sau, thử nha:

(+) Phải chuột vô tên 'Sheet1', chọn dòng cuối để mở cửa sổ VBE;
(+) Thêm dòng lệnh như sau để có được như dưới đây
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
 [B]On Error GoTo Loi_WSh[/B]  [COLOR=Blue]'<= Dòng thêm mới'[/COLOR]
 Dim Rng As Range, sRng As Range, Clls As Range
' . . . . . '
(+) Thêm các dòng lệnh vô cuối macro, để sau khi thêm, chúng ta có đoạn cuối macro như sau:
Mã:
' . . . . . . . . '
End If [COLOR=Blue]'Các dòng tô đâm dưới đây là mới cần phải thêm'[/COLOR]
[B]Err_WSh:            Exit Sub
Loi_WSh:
    Select Case Err
    Case Is <> 94
        MsgBox Error, , Err
    End Select
    Resume Err_WSh[/B]
End Sub
Chúng có tác dụng loại trừ lỗi 94.

Chờ tin từ bạn.
 
Mình đã thử thêm vào những đoạn lệnh ở trên, mỗi lần làm giống như mình nói ở bài #32 thì nó không báo lỗi nữa nhưng mà nó đứng luôn không làm gì được hết luôn bạn ơi. Mình có gửi kèm theo file đã thêm các đoạn ở trên nè, bạn xem lại giúp mình nha, thank bạn nhiều nhiều-=.,,-=.,,-=.,,.
Chúc bạn cả tuần vui vẻ, thuận lợi:-=:-=
 

File đính kèm

#22: Và khi ta copy 5 hàng ngang ví dụ như từ hàng ngang số 10 đến số 15 và insert copies cell vào hàng ngang số 3 thì cũng . . . .

Có phải bạn muốn copy 6 hàng từ hàng thứ 10 & đem chúng dán lên hàng 4, phải không?
Mình làm trơn tru mà! - Không có tý lỗi nào sất!

Trong hàng thú 3 của bạn tại sheet1 có các ô trộn với hàng trên; Bạn dán vô đấy thì làm sao còn là 1 trang tính bình thường được; Nó báo lỗi là may cho bạn rồi!
Nếu không báo lỗi thì dữ liệu của bạn thành đồ vứt đi ấy chứ, ai mà xài tiếp được nữa chừ!

:-= --=0 &&&%$R !$@!!
 
Cái copy vô hàng thứ 3 là mình chỉ ví dụ như là 1 hàng ngang vậy thôi bạn ơi, bạn thử vào file mình mới đính kèm ở trên delete 1 hàng ngang bất kỳ thử xem, sau khi delete hoặc insert 1 hàng ngang bất kỳ là nó bị đứng luôn mà. Tương tự khi copy nhiều hàng ngang rồi đặt vào 1 hàng ngang bất kỳ là nó bị đứng ah. Bạn xem lại giúp mình nha.
 
Lần chỉnh sửa cuối:
Cái copy vô hàng thứ 3 là mình chỉ ví dụ như là 1 hàng ngang vậy thôi bạn ơi,. . .

Nói bạn đừng giận, chứ bạn vô trách nhiệm với ví dụ của bạn thật đó.
Có phải dòng nào trên trang tính cũng giống dòng nào đâu mà bạn muốn viết sao thì viết?!
Nhất là bạn đang làm việc tại 1 cơ sở khoa học, mà ở đó theo mình biết, độ chuẩn xác & tính khoa học lúc nào cũng cao hơn mặt bằng cộng đồng dân trí bất kỳ tỉnh thành nào trong cả nước.

bạn thử vào file mình mới đính kèm ở trên delete 1 hàng ngang bất kỳ thử xem, sau khi delete hoặc insert 1 hàng ngang bất kỳ là nó bị đứng luôn mà. Tương tự khi copy nhiều hàng ngang rồi đặt vào 1 hàng ngang bất kỳ là nó bị đứng ah. Bạn xem lại giúp mình nha.
Trước khi viết bài trên, mình đã thử bằng chính file đó rồi, đánh dấu nguyên vài dòng & xóa, củng như copy 1 số dòng tứ sheets("TaiDay") qua vẫn không có lỗi như bạn nói.

. . . . . thôi, Bye vậy.
 
Nếu như không bị gì thì mình cũng không phải mất công hỏi hoài như vậy đâu. Dù sao cũng cảm ơn bạn rất nhiều.
 
Không phải đâu, bạn ChiBi à!

Bỏ thử dòng lệnh "Application.ScreenUpdating = False"

Mình mường tượng ra sao rồi;

TheVu01 ra cửa hàng dịch vụ, hay đến máy nào TheVu01 chưa ngồi lần nào; Lấy file trên về & chạy thử ngay trên đó cái macro ấy xem sao?!

Nếu trơn tru, mình đã chẩn đúng bệnh rồi đó.
 
Cảm ơn các bạn nhiều lắm để mình thử rồi mình báo cho các bạn sau nha.@$@!^%&&&%$R
 
Cả tuần nay bận quá nên đến hôm nay mới ra tiệm net test được. Mình đã thử với 2 máy ở tiệm net nhưng vẫn bị vậy bạn ChanhTQ@ ơi. Không biết bạn ChanhTQ@ có hiểu sai ý mình không chứ quả thật là bị lỗi chứ nếu không mình làm vậy để làm gì, ở sheet1 mình dùng chuột chọn hết 1 hàng ngang ví dụ như hàng ngang số 8, rồi click chuột phải chọn delete hoặc insert là nó bị đứng file.

Mình đã thử bỏ dòng lệnh "Application.ScreenUpdating = False" như bạn chibi hướng dẫn thì đã chạy trơn tru, tuy nhiên vẫn bị lỗi 94 nên vẫn phải để đoạn code loại trừ lỗi 94 của bạn ChanhTQ@.
Nhưng mà nếu bỏ đoạn code "Application.ScreenUpdating = False" vậy có ảnh hưởng gì không vậy mấy 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í

Xin chào các bạn, lúc trước mình được bạn ChanhTQ@ giúp làm phần code để làm việc, bây giờ tổng số sinh viên của mình cần phải để trong CSDL đã vượt qua số 12000, cụ thể là khoảng 19000. Nên mình muốn hỏi làm thế nào để chỉnh sửa trong code, vì mình thật sự không biết về code nên không dám sửa lung tung, mong được các bạn giúp đỡ:

Option Explicit
Const SoSV As Integer = 11999
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Loi_WSh
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
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
Err_WSh: Exit Sub
Loi_WSh:
Select Case Err
Case Is <> 94
MsgBox Error, , Err
End Select
Resume Err_WSh
End Sub
 
Nên sửa thành
PHP:
Const SoSV As Integer = 32000

Nếu chuẩn bị vượt 3 vạn SV thì nên khai báo là
Mã:
[B]Const SoSV As Long = 10^7[/B]
 

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

Back
Top Bottom