Trích lọc nhiều vùng trong một Sheets

[khoa_pr]

Xin chào tất cả các thành viên!
Tôi Đang làm một bảng điểm dùng cho giáo viên chủ nhiệm. Tuy nhiên khi viết code VBA để trích lọc danh sách học sinh Giỏi (DSHS_G), DSHS tiên tiến (DSHS_TT) thì bị kẹt, mong mọi người giúp đỡ.
Thông thường thì Điểm HK1 làm 1 sheet, HK2 làm 1 sheet, Cả năm làm 1 sheet. Nhưng để cho gọn tránh nhiều Sheet trong một Workbook, tôi làm cả 3 trong một Sheet, nên khi trích lọc có rắc rối.
Tôi có đính kém tập tin, mong mọi người đọc ở trang Yêu cầu, xem nội dung và giúp đỡ.
Cám ơn.

 

[ChanhTQ@]

Các macro của bạn đây

Option Explicit
Dim Rng As Range
[B]Sub HocKyI()[/B]
   Set Rng = Range("U6:U60")
   GPE Rng
[B]End Sub[/B]

[B]Sub CaNam()[/B]
   Set Rng = Range("U140:U200")
   GPE Rng
[B]End Sub[/B]

Sub GPE(Rng As Range)
 Dim Sh As Worksheet
 Dim sRng As Range
 Dim jJ As Byte, Zz As Byte
 Dim MyAdd As String, DHieu As String, Col As String
 
2 Set Sh = Sheets("HSG-HSTT")
 Sh.Rows("7:60").Clear
4 For jJ = 1 To 2
   DHieu = Choose(jJ, "HSG", "HSTT")
6   Col = Choose(jJ, "B", "AC")
   Set sRng = Rng.Find(DHieu, , xlValues, xlWhole)
8   If Not sRng Is Nothing Then
      MyAdd = sRng.Address
10      Do
         Sh.Cells(65500, Col).End(xlUp).Offset(1).Resize(, 23).Value = _
            sRng.Offset(, -19).Resize(, 23).Value
12         Set sRng = Rng.FindNext(sRng)
      Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
14   Else
      MsgBox "Khong Co Danh Hieu " & DHieu
16   End If
 Next jJ
End Sub

Chú í: Bạn phải điền đủ tên học sinh trước khi chạy từng macro, cho dù chỉ là GPE 01, GPE 02,. . . .

 

[khoa_pr]

Chào bạn ChanhTQ!
Xin chân thành cám ơn bạn đã giúp đỡ cách lọc DSHS G-TT. Tuy nhiên có điều này mong bạn xem lại và giuýp đỡ:
1- Sau khi chép đoạn code trên và chạy thử, thì khi nhấn nút Loc DSHS G-TT HK1 thì macro trích dữ liệu vào đúng sheets HSG-HSTT vùng 6:60 của HSG và HSTT. khi nhấn nút Loc DSHS G-TT Ca nam thì macro cũng trích vào vùng HK1 của HSG-HSTT. Nhưng nếu tôi tạo dòng tiêu đề cho vùng cả năm của sheets HSG-HSTT (140:190) thì du nhấn nut HK1 hay Ca năm macro đều trích lọc vào vung 140:190 chứ không thèm vung 6:60 nữa. Tại sao vậy? Tôi có gởi lại file đính kèm.
2- Mong bạn giúp cho đoạn code đánh lại số thứ tự của từng vùng DSHS sau khi trích lọc, code để kẻ lại Border theo từng vùng DSHS.
3- Tôi không hiểu tại sao chỉ có 4 sheets nhưng dung lượng lại quá lớn tới gần 7MB. Mong bạn ChanhTQ và mọi người giúp đỡ.
Xin chân thành cảm ơn

 

[ChanhTQ@]

(Mình vừa quýnh số vô các dòng lệnh, bạn đối chiếu với chúng nha!)

Tuy nhiên có điều này mong bạn xem lại và giuýp đỡ:
1- Sau khi chép đoạn code trên và chạy thử, thì khi nhấn nút Loc DSHS G-TT HK1 thì macro trích dữ liệu vào đúng sheets HSG-HSTT vùng 6:60 của HSG và HSTT. khi nhấn nút Loc DSHS G-TT Ca nam thì macro cũng trích vào vùng HK1 của HSG-HSTT. Nhưng nếu tôi tạo dòng tiêu đề cho vùng cả năm của sheets HSG-HSTT (140:190) thì du nhấn nut HK1 hay Ca năm macro đều trích lọc vào vung 140:190 chứ không thèm vung 6:60 nữa. Tại sao vậy? Tôi có gởi lại file đính kèm.

Thiết kế ban đầu của bạn là 2 vùng thuộ các dòng từ 6 cho đến 60 (Xem dòng lệnh 3: Tạo bãi đáp cho dữ liệu HSG & HSTT vô vùng tương ứng)
Bạn đổi lại thiết trí từ dòng 140:190 thì dòng lệnh 11 sẽ chép dữ liệu vô dòng trống cuối cùng của trang tính. Nên nó sẽ chép như vậy;
Nếu bạn muốn HSG chép từ dòng thứ 7 & HSTT chép từ dòng 141 thì sẽ phải viết lại vài dòng lệnh.

2- Mong bạn giúp cho đoạn code đánh lại số thứ tự của từng vùng DSHS sau khi trích lọc, code để kẻ lại Border theo từng vùng DSHS.

Chúng ta phải khẳng định câu (1) xong cái đã. Chỉ sau khi đó ta mới 'Trang trí'

3- Tôi không hiểu tại sao chỉ có 4 sheets nhưng dung lượng lại quá lớn tới gần 7MB. Mong bạn ChanhTQ và mọi người giúp đỡ.
Xin chân thành cảm ơn

Đúng, Gần 6,6Mb; Có vấn đề này có thể gây ra nguyên nhânn trên: Khi mở file, thì excel hỏi ta có nối kết tới đâu đó không (?) Bạn xem lại cái nghi vấn này đi!

 

[khoa_pr]

Chào bạn
Không phải là mình đổi lại thiết kế, nhờ bạn đọc kỹ lại trang "Yeucau". Dòng từ 6:60 cho 2 đối tượng à HSG và HSTT của HK1, còn vùng từ 140:190 gồm 2 vùng cho HSG và HSTT của cả năm. Như vậy khi nhấn nút Loc DSHS G-TT HK1 thì lọc ở bảng điểm HK1 (6:60), Nhấn nút Loc DSHS G-TT Ca nam thì lọc HSG-HSTT của bảng điểm Cả năm vào vùng 140:190.
Mong bạn xem kỹ và giúp đỡ.

 

[ChanhTQ@]

À mình xin lỗi bạn nha!

Chào bạn
Không phải là mình đổi lại thiết kế, nhờ bạn đọc kỹ lại trang "Yeucau". Dòng từ 6:60 cho 2 đối tượng à HSG và HSTT của HK1, còn vùng từ 140:190 gồm 2 vùng cho HSG và HSTT của cả năm. Như vậy khi nhấn nút Loc DSHS G-TT HK1 thì lọc ở bảng điểm HK1 (6:60), Nhấn nút Loc DSHS G-TT Ca nam thì lọc HSG-HSTT của bảng điểm Cả năm vào vùng 140:190.
Mong bạn xem kỹ và giúp đỡ.

Bạn lấy macro này chép đè lên cái cũ giúp nha!

Sub GPE(Rng As Range)
1 Dim Sh As Worksheet:                     Dim sRng As Range
 Dim jJ As Byte, Zz As Byte:              Const Dong As Integer = 135 '<=|'
 Dim MyAdd As String, DHieu As String, Col As String
 
4 Set Sh = Sheets("HSG-HSTT")
 If Rng.Cells(1, 1).Row < 99 Then Zz = 1 Else Zz = 2  '<=|'
6 If Zz = 1 Then                                     '<=|'
   Sh.Rows("7:60").ClearContents             '<=|'
8 Else                                                    '<=|'
   Sh.Rows("141:200").ClearContents         '<=|'
10 End If                                                 '<=|'
 For jJ = 1 To 2
12   DHieu = Choose(jJ, "HSG", "HSTT")
   Col = Choose(jJ, "B", "AC")
14   Set sRng = Rng.Find(DHieu, , xlValues, xlWhole)
   If Not sRng Is Nothing Then
16      MyAdd = sRng.Address
      Do
18         Sh.Cells(Dong * Zz, Col).End(xlUp).Offset(1).Resize(, 23).Value = _
            sRng.Offset(, -19).Resize(, 23).Value          '<=|'
            
         Set sRng = Rng.FindNext(sRng)
20      Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
   Else
22      MsgBox ""
   End If
24 Next jJ
End Sub

 

[khoa_pr]

Bạn ChanhTQ@ ơi!
Đã giúp thì giúp cho tròn, ai nỡ bỏ tơi giữa đường thế.
Bạn xem giúp mình cách kẻ thêm các Border và đánh lại số thứ tự từ 1 đến hết các DSHS G-TT sau khi được trích lọc ra với. Đừng để nó "Trần trụi giữa đường" thiếu văn hóa lắm he he . . .
Ah, nhờ bạn giải thích giúp luôn nhé, đoạn code dứơi mình không hiểu ý nghĩa của nó:
Sh.Cells(Dong * Zz, Col).End(xlUp).Offset(1).Resize(, 23).Value = _
sRng.Offset(, -19).Resize(, 23).Value '<=|'
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
Cám ơn bạn nhiều nhé.

 

[khoa_pr]

Trích lọc cùng lúc 4 điều kiện sang một sheets

Chào mọi người!
Cũng với nội dung trên, với Code của bạn ChanhTQ@, chỉnh sửa sao cho phù hợp để yêu cầu trích cùng một lúc 4 điều kiện: Lên lớp, Thi lại, Ở lại và Rèn hạnh kiểm từ sheets "GVCN" sang sheets có tên "LL_TL_OL_RHK" sang 4 vùng giống như trích HSG, HSTT sang sheet HSG_HSTT vậy (Vùng 6:60 cho "Lên lớp và Thi lai", vùng từ 140:190 cho "Ở lại và Rèn hạnh kiểm".
Mong được mọi người giúp đở.
Cám ơn!

 

[ChanhTQ@]

(1) Bạn xem giúp mình cách kẻ thêm các Border và (2) đánh lại số thứ tự từ 1 đến hết các DSHS G-TT sau khi được trích lọc ra với.

Đừng để nó "Trần trụi giữa đường" thiếu văn hóa lắm he he . . .

(3) Ah, nhờ bạn giải thích giúp luôn nhé, đoạn code dứơi mình không hiểu ý nghĩa của nó:
Sh.Cells(Dong * Zz, Col).End(xlUp).Offset(1).Resize(, 23).Value = _
sRng.Offset(, -19).Resize(, 23).Value '<=|'
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
Cám ơn bạn nhiều nhé.

Xin bổ sung cho nó một tẹo văn hóa đây:
(2): (Mình vừa thêm các số vô dòng lệnh). Bạn thêm hai dòng này vô ngay sau dòng lệnh 20 nha:

     DanhSTT Sh.Cells(7, Col).Offset(, -1)         '<=|'
      DanhSTT Sh.Cells(141, Col).Offset(, -1)          '<=|'

& còn việc quan trọng nữa đó là chép macro này vô xuống dưới macro đó:

Sub DanhSTT(Rng As Range)
    Rng.FormulaR1C1 = "=IF(RC[1]="""","""",N(R[-1]C)+1)"
    Rng.AutoFill Destination:=Rng.Resize(50), Type:=xlFillDefault
End Sub

Để khi cần nó gọi thì có sẵn cho nó khoan khái, chứ không nó cự nự là tui không chịu trách nhiệm đâu nha!
Macro này làm việc hơi rỗi công, nhưng sau sẽ gọt tỉa thêm.

(1) Bạn muốn định dạng ra sao? Kể khung giống tiêu đề hử? . . .

(3) (a) Vì chúng ta cần chép vào 2 nơi khi triệu gọi chỉ 1 macro trong 1 lần, nên khai báo hằng số 135 để tách biết chép cả năm (từ dòng 141) hay học kỳ 1 (dòng 7 - 60)
Biến Col sẽ đưa ra mã cột đầu tiên cần chép dữ liệu đến
Biến Zz sẽ nhận 1 trong 2 trị, đó là 1 hay 2;

Trong trường hợp Zz=1 sẽ giống như ta chọn cô [B135] & nhấn tổ hợp {CTRL}+ mũi tên lên (để đến ô có dữ liệu gần nhứt trên nó. Việc này giúp ta chép đúng nơi đúng chổ mà thôi)
Còn hai dòng sau nữa (b) & (c): Bạn nên đến BOX lập trình, tìm bài về phương thức tìm kiếm mà nghiền ngẫm trước đi thì hơn! Viết đây sẽ không đủ giấy mực đâu!

Chúc thành công!

 

[khoa_pr]

kẻ khung Border sau khi trich loc

Xin bổ sung cho nó một tẹo văn hóa đây:

(1) Bạn muốn định dạng ra sao? Kể khung giống tiêu đề hử? . . .

Chào bạn!
Cám ơn bạn đã trả lời mình về cách đánh số thứ tự. Mình tưởng bạn không thèm xem lại nhứng thắc mắc của mình.
Kẻ Border ở đây có nghĩa là sau khi trích lọc HSG-HSTT và đánh lại STT, có bao nhiêu học sinh được trích lọc thì hãy đóng khung cho bấy nhiêu hs đó ở cả HSG và HSTT.
Cám ơn bạn nhé.
Bạn nói vào BOX lập trình là chổ nào để tìm hiều thêm về phương thức tìm kiếm?

 

[ChanhTQ@]

Thêm 1 macro & đại tu 2 macro cũ, tiểu tu 1 cái: là xong

Cám ơn bạn đã trả lời mình về cách đánh số thứ tự. Mình tưởng bạn không thèm xem lại nhứng thắc mắc của mình.
(1) Kẻ Border ở đây có nghĩa là sau khi trích lọc HSG-HSTT và đánh lại STT, có bao nhiêu học sinh được trích lọc thì hãy đóng khung cho bấy nhiêu hs đó ở cả HSG và HSTT.
Cám ơn bạn nhé.
(2) Bạn nói vào BOX lập trình là chổ nào để tìm hiều thêm về phương thức tìm kiếm?

(1)

Option Explicit
Dim Rng As Range, Sh As Worksheet
Sub HocKyI()
   Set Rng = Range("U6:U60"):                GPE Rng
   Sh.Select
   Set Rng = Sh.Range("A7:Y" & Sh.[b135].End(xlUp).Row)
   FormatBoders Rng
   FormatBoders Sh.Range("AB141:AZ" & Sh.[AC135].End(xlUp).Row)
   Sh.Select:                                Set Sh = Nothing
End Sub

Sub CaNam()
   Set Rng = Range("U140:U200"):             GPE Rng
   Sh.Select
   FormatBoders Sh.Range("AB141:AZ" & Sh.[AC345].End(xlUp).Row)
   FormatBoders Sh.Range("A141:Y" & Sh.[b345].End(xlUp).Row)
   Sh.Select:                                Set Sh = Nothing
End Sub

[B]Sub GPE(Rng As Range)[/B]
 Dim sRng As Range, dRng As Range
 Const Dong As Integer = 135
 Dim jJ As Byte, Zz As Byte, wW  'As Byte
 Dim MyAdd As String, DHieu As String, Col As String
 
 Set Sh = Sheets("HSG-HSTT"):             Sh.Select
 If Rng.Cells(1, 1).Row < 99 Then Zz = 1 Else Zz = 2
 If Zz = 1 Then
   Rows("7:60").Clear    '<=|'
 Else
   Rows("141:200").Clear  '<=|'
 End If
 For jJ = 1 To 2
   DHieu = Choose(jJ, "HSG", "HSTT")
   Col = Choose(jJ, "B", "AC")
   
   Set sRng = Rng.Find(DHieu, , xlValues, xlWhole)
   If Not sRng Is Nothing Then
      MyAdd = sRng.Address
      Do
         Set dRng = Cells(Dong * Zz, Col).End(xlUp).Offset(1).Resize(, 23) '*'
         dRng.Value = sRng.Offset(, -19).Resize(, 23).Value    '<=|'
         Set sRng = Rng.FindNext(sRng)
      Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
      DanhSTT Cells(7, Col).Offset(, -1)
      DanhSTT Cells(141, Col).Offset(, -1)
   Else
      MsgBox ""
   End If
 Next jJ
[B]End Sub[/B]

Sub DanhSTT(Rng As Range)
    Rng.FormulaR1C1 = "=IF(RC[1]="""","""",N(R[-1]C)+1)"
    Rng.AutoFill Destination:=Rng.Resize(50), Type:=xlFillDefault
End Sub

Sub FormatBoders(dRng As Range)
 On Error Resume Next:                       Dim jJ As Byte
 dRng.Select
 For jJ = 7 To 12
    With dRng.Borders(jJ)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
 Next jJ
 Sheets("GVCN").Select
End Sub

(2) (Lười quá lắm nhe!)
http://giaiphapexcel.com/forum/showthread.php?t=15116

 

[khoa_pr]

Cảm ơn bạn ChanhTQ nhiều nhé!

 

[khoa_pr]

Có lỗi trong việc kẻ Border sau khi lọc

Chào bạn ChanhTQ
sau khi chép đoạn code đánh STT và kẻ Border của bạn, có hiện tượng như sau:
Khi tôi nhấn nút Chọn DSHS và Click vào 2 OptionButton DSHS-G, TT HK1 và Option DSHS-G, TT Canam thì cột A và cột AB bị kẻ Border trong khi bên cột B và AC (Ho va tên) không có tên hs. Tôi đã tìm cách chỉnh sữa nhưng không được mong bạn xem giúp.
Theo tôi có` lẽ nó bị lỗi ở đoạn code:
DanhSTT sh.Cells(7, Col).Offset(, -1) '<=|'
DanhSTT sh.Cells(39, Col).Offset(, -1) '<=|'

và Sub DanhSTT(Rng As Range)
Rng.FormulaR1C1 = "=IF(RC[1]="""","""",N(R[-1]C)+1)"
Rng.AutoFill Destination:=Rng.Resize(30), Type:=xlFillDefault
End Sub
Tôi có gởi kèm file, xin bạn hãy xem lại code ModuleTrichloc giúp với nhé
Cám ơn bạn nhiều.

 

[ChanhTQ@]

Trước tiên bạn sửa giúp 1 dòng lệnh được đánh dấu dưới đây

Sub HocKyI()
   Set Rng = Range("U6:U60"):                GPE Rng
   Sh.Select
   Set Rng = Sh.Range("A7:Y" & Sh.[b135].End(xlUp).Row)
   FormatBoders Rng
   FormatBoders Sh.Range("AB7:AZ" & Sh.[AC135].End(xlUp).Row) '<=|'
   Sh.Select:                                Set Sh = Nothing
End Sub

 

[khoa_pr]

Chào ChanhTQ
Tại sao trong Sub HockyI và Canam dong 2 (sh.select) đúng ra ta phải Set sh=sheets("HSG-HSTT") sau đó mới sh.select. Nên khi tôi chạy code đều bị báo lỗi và tô màu vàng khè, khi tôi thay tất cả sh bằng tên của sheet HSG-HSTT thì nó mới thôi báo lỗi.

 

[160588]

mình muốn tìm 1 bài tập excel có liên kết các sheet với nhau. ai giúp mình với

 

[ChanhTQ@]

Tại sao trong Sub HockyI và Canam dong 2 (sh.select) đúng ra ta phải Set sh=sheets("HSG-HSTT") sau đó mới sh.select. Nên khi tôi chạy code đều bị báo lỗi và tô màu vàng khè, khi tôi thay tất cả sh bằng tên của sheet HSG-HSTT thì nó mới thôi báo lỗi.

Vấn đề là bạn khai báo biến Sh đó ở đâu? Liên quan đến vấn đề này, đó là macro GPE bạn để nó ở đâu nữa?

Của mình chưa báo lỗi trường hợp như bạn nêu do mình khai báo 2 biến dùng chung Sh & Rng trong module của trang tính & trong nó chứa toàn bộ các macro mà chúng ta có.

Thực ra trong macro GPE đã thực hiện các sự việc bạn nêu; Đó là
Gán trang tính cho biến Sh;
thực hiện lệnh Select với biến đối tượng này!

Xem lại cái nha & chúc thành công!

 

[khoa_pr]

Chào ChanhTQ
Vấn đề báo lỗi mình sửa luôn sh thành sheets("HSG-HSTT") thì nó không báo lỗi nữa. bỏ qua vấn đề này nhé.
Mong bạn xem giúp code tại sao sau khi thêm code DanhSTT thì cột A và AB của "HSG-HSTT" tự động kẻ Border sau khi loc, dù danh sách trích lọc chỉ có 1 người. File đính kèm ngày 21-11-2009 mình gởi lên.

 

[SA_DQ]

Bạn hãy kiểm thử theo file đính kèm tạm nha



Chưa hoàn toàn, nhưng tạm được.

 

[khoa_pr]

Đánh số thứ tự và kẻ Border

Chưa hoàn toàn, nhưng tạm được.

Chào bạn HYen17!
Cám ơn bạn đã giúp đỡ cách đánh số thứ tự và kẻ Border.
Đánh số thứ tự bằng cách gán công thức "=IF(RC[1]="""","""",N(R[-1]C)+1)" vào cột A và AB. Nhưng khi loc HK1 thì cột A HK2 tự kẻ Border cả cột, khi lọc Cả năm thì cột A của HK1 tự kẻ Border. hãy đừng cho nó kẻ Boder vượt quá số ngưới được lọc trong cột B. Bạn hãy xem giúp mình File đính kèm mình đã gời ngày 21/11/2009, vì mình đã chỉnh lại nội dung cho ngắn gọn lại.
Cám ơn bạn nhé.