Hỏi:V/v tối ưu dữ liệu và tạo một macro để in danh sách phòng thi có trong list.

Liên hệ QC

QuocPhong

Learning to be!
Tham gia
21/11/07
Bài viết
256
Được thích
247
Mình có một file dữ liệu dùng để làm công tác tuyển sinh đầu cấp bao gồm các sheet sau:
- Sheet Tonghop: nhập thông tin chung.
- 5 sheet tương ứng với 5 môn chuyên: dữ liệu được cập nhật bằng công thức từ sheet Tonghop.
- Các sheet còn lại là bảng ghi tên ghi điểm, Ds phòng thi,... của từng môn.
Vấn đề ở chỗ là file dữ liệu của mình mỗi lần thực hiện tính toán rất chậm nên mỗi lần thao tác mình phải đợi nên rất tốn thời gian. (Máy của mình cũng hơi yếu).
Nhờ các bạn giúp đỡ mình trong tối ưu dữ liệu và tạo một macro dùng để in danh sách thí sinh của tất cả các phòng thi có trong list.
Trân trọng cảm ơn.
 

File đính kèm

Bạn xài quá nhiều Sheets, mình cảm thấy vậy

Hãy xem sheets("Mon") & Sheets("PhThi") của mình xem sao; Tương ứng với chúng là 2 ô [G10] & ô trộn từ [F2:G2]

Nếu ưng bụng thì chúng ta sẽ tiếp tục sang 2 sheets còn lại!
 

File đính kèm

Cảm ơn bạn! Mình không rành VBA nên nhờ bạn làm giúp mình 2 sheet còn lại.
Code trên chỉ là Advanced Filter bình thường thôi mà bạn!
Tuy nhiên tôi cảm thấy code trên phải dùng đến cột phụ và vùng điều kiện phụ (tại sheet Tổng hợp)... chưa hay lắm ---> Theo tôi dùng AutoFilter là gọn nhẹ nhất, khỏi cần bất cứ vùng phụ nào!
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$G$10" Then
    Application.ScreenUpdating = False
    Range("A24:O1000").ClearContents
    With Sheets("Tonghop")
      With .Range(.[C4], .[C65500].End(xlUp)).Resize(, 12)
        .AutoFilter 8, Target
        .Offset(1).Copy Destination:=[C24]
        .AutoFilter
      End With
    End With
    With Range([C24], [C65500].End(xlUp))
      .Offset(, -1).FormulaArray = "=Left(G10)&Text(ROW(R1:R1000),""000"")"
      .Offset(, -1).Value = .Offset(, -1).Value
      .Offset(, -2).FormulaArray = "=MOD(ROW(R1:R1000)-1,24)+1"
      .Offset(, -2).Value = .Offset(, -2).Value
      .Offset(, 12).FormulaR1C1 = "=COUNTIF(R24C1:RC1,1)"
      .Offset(, 12).Value = .Offset(, 12).Value
      [G2] = .Rows.Count
    End With
  End If
End Sub
Đây là code lọc cho Sheet MON...
Các sheet khác cũng gần tương tự mà thôi!
 

File đính kèm

Mình thấy cách sử dụng Filter này giúp cho việc xử lý nhanh hơn, gọn hơn nhưng còn một vấn đề là việc nhập kết quả sau khi thi của các môn. Vậy thì mình phải làm như thế nào?
 
Mình thấy cách sử dụng Filter này giúp cho việc xử lý nhanh hơn, gọn hơn nhưng còn một vấn đề là việc nhập kết quả sau khi thi của các môn. Vậy thì mình phải làm như thế nào?
Mình gửi thêm code tại sheet PhThi ---> Cũng toàn code, chẳng có tí công thức nào
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$F$2" Then
    Range("F3") = Sheets("Mon").Range("G10")
    Range("A8:G1000").ClearContents
    With Sheets("Mon").Range("A23").CurrentRegion
      Range("B8").Resize(24, 6).Value = .Offset((Target - 1) * 24 + 1, 1).Resize(24, 6).Value
    End With
    With Range("B7").CurrentRegion
      If .Rows.Count > 1 Then
        .Resize(, 1).SpecialCells(4).Value = Evaluate("ROW(R1:R1000)")
      End If
    End With
  End If
End Sub
Ở đây cũng dùng AutoFilter (chẳng qua làm bằng tay thế nào thì ghi lại thành code thôi)
(Bên sheet MON cũng đã sửa lại không dùng công thức)
Riêng 2 sheet còn lại, có lẻ mình không chuyên ngành nên chưa hiểu lắm! Bạn giải thích thêm tí được không?
 

File đính kèm

Mình gửi thêm code tại sheet PhThi ---> Cũng toàn code, chẳng có tí công thức nào
Ở đây cũng dùng AutoFilter (chẳng qua làm bằng tay thế nào thì ghi lại thành code thôi)
(Bên sheet MON cũng đã sửa lại không dùng công thức)
Riêng 2 sheet còn lại, có lẻ mình không chuyên ngành nên chưa hiểu lắm! Bạn giải thích thêm tí được không?

Hai sheet còn lại vẫn tương tự thôi bạn à. Mình sẽ in ra tất cả 3 mẫu: Bảng ghi tên ghi điểm, DS phòng thi, Phiếu thu bài thi các môn.
Giống như lúc trước mình làm thì 5 môn chuyên mình tách ra 5 sheet tương ứng với các môn. Sau khi thi xong thì kết quả điểm thi sẽ được nhập vào các sheet đó và lấy kết quả Đậu hoặc Rớt. Dùng Filter vậy thì mình có thể nhập kết quả điểm được không?
 
Dùng Filter vậy thì mình có thể nhập kết quả điểm được không?
Tôi đoán chắc bạn muốn NHẬP sau khi đã Filter?
Đương nhiên là không đươc, vì bạn có nhập gì thì Filter lần nữa nó cũng xóa sạch!
Vậy nếu bạn muốn nhập vào vùng dử liệu sau khi đã Filter, bạn phải copy nó sang nơi khác rồi hẳn nhập!
2 sheet còn lại để tôi nghiên cứu thêm ---> Các cao thủ ai có kinh nghiệm về ngành GD hãy phụ 1 tay (hiểu vấn đề làm nhanh lắm... không hiểu thì thấy nó mù mờ thế nào ấy)
 
2 sheet còn lại thì làm cũng giống y như sheet phòng thi mà bạn làm cho mình thôi.
 
Đây là macro của sheets("GDiem")

PHP:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [G2]) Is Nothing Then
   Dim Sh As Worksheet, Rng As Range
   Set Sh = Sheets("Mon")
   If [G2].Value > Sh.[g6].Value Then [G2].Value = Sh.[g6].Value
   Set Rng = Sh.Cells(24 * [G2].Value, "B").Resize(24)
   [b8].Resize(24).Value = Rng.Value
   Set Rng = Rng.Offset(, 1).Resize(, 12)
   [f8].Resize(24, 12).Value = Rng.Value
 End If
End Sub

Còn sheets cuối giống hệt macro có trong 'PhThi'
Nếu chịu khó, ta có thể viết 1 macro tại 'PhThi' & nhập chung vô sheets cuối này luôn
(Lúc đó lại phải cài 1 số Names để có tiếng Việt trong 1 số ô trang tính)

Vấn đề nhập điểm sau khi chấm thi:
Bạn nên thêm cột MaHS tại CSDL (Sheets("TongHop")), chứ không phải cứ mỗi lần trích lọc, 1 lần tạo mã như vậy;
Sau đó thêm 1 sheet 'NhapDiem' giống như 1 trong 3 sheets cuối,
Khi đó, ta gọi từng lờp (Phòng thi) ra & nhập điểm bằng tay cho 24 em;
Sau khi nhập xong ta nhấn nút để macro chép điểm nhập vô 'TongHop' luôn!
Tất nhiên bạn phải áp sẵn các trường điểm này trên 'TongHop' trước;
Nếu còn chưa hiểu rõ, bạn hãy cho biết số các môn thi của các khối xem sao! Chúng ta sẽ tiếp tục.
 
Nếu còn chưa hiểu rõ, bạn hãy cho biết số các môn thi của các khối xem sao! Chúng ta sẽ tiếp tục.

Hiện tại thì trường mình chỉ tuyển 5 lớp chuyên: Toán, Lý, Hóa, Anh, Văn. Thi chỉ có 3 môn: Toán + Văn + Môn chuyên.
Mọi năm mình tách riêng ra thành 5 sheet: Toán, Lý, Hóa, Anh, Văn. Khi hội đồng thi chấm điểm xong thì họ sẽ nhập điểm trực tiếp vào 5 sheet đó.
Mình gởi kèm file Bảng ghi tên ghi điểm.
 
Lần chỉnh sửa cuối:
Hiện tại thì trường mình chỉ tuyển 5 lớp chuyên: Toán, Lý, Hóa, Anh, Văn. Thi chỉ có 3 môn: Toán + Văn + Môn chuyên.
Mọi năm mình tách riêng ra thành 5 sheet: Toán, Lý, Hóa, Anh, Văn. Khi hội đồng thi chấm điểm xong thì họ sẽ nhập điểm trực tiếp vào 5 sheet đó.
Mình gởi kèm file Bảng ghi tên ghi điểm.

Mình & bạn chúng ta thảo luận vấn đề nhập điểm thi đầu vào cái đã, Còn file bạn đưa lên đó là bảng điểm năm học mà. Về cái này khoan hẵn nói tới;

Nếu thi ba môn thì những em chuyên toán & chuyên văn thi có 2 môn thôi sao?
Hay thi môn nào khác thay thế; Bạn nên rõ ràng chổ này. Vì việc xây dựng CSDL là nền tảng của vấn đề đó nha!

Dù sao bạn cũng cần lập mã học sinh với sự trợ giúp của macro sau đây.

Trước khi chạy macro tạo mã HS tại sheets("TongHop") chúng ta xét rằng cột 'A' đang là vô vị, sẽ bỏ nó đi bằng cách sau:

Bạn chọn cột 'C' (file tại #2), vô menu Insert để thêm 1 cột mới
tại [C4] ta nhập:= "MaHS"
(Bạn đến vùng AD4:AD9 sẻ chứa các bộ môn chuyên; Thực ra vùng này đã được gán tên)
Bạn chép macro này vô cửa sỗ VBE & cho nó chạy

PHP:
Option Explicit
Sub TaoMaHS()
 Dim Clls As Range, Rng As Range, sRng As Range
 Dim MyAdd As String
 Dim Dem As Integer
 
 Set Rng = Range([k4], [k4].End(xlDown))
 For Each Clls In Range([Ad5], [ad9])
   Set sRng = Rng.Find(Clls.Value, , xlFormulas, xlWhole)
   If Not sRng Is Nothing Then
      MyAdd = sRng.Address:         Dem = 0
      Do
         Dem = Dem + 1
         Cells(sRng.Row, "C").Value = Left(Clls.Value, 1) & Right("00" & CStr(Dem), 3)
         Set sRng = Rng.FindNext(sRng)
      Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
   End If
 Next Clls
End Sub

Sau đó ta kiểm tra thử vài chục ô trên cột 'C'; Nếu đã thỏa, ta xóa cột 'A' đi
Từ đây trở đi ta chỉ cần cột MaHS này, chứ không cần biết tên em này trùng tên em kia làm chi!

Nếu bạn không làm được mình sẽ đưa file lên sau vài ngày nữa.

(Vì trước sau gì bạn cũng trãi qua VBA, đừng chối bỏ nó, tội nghiệp mà!
Lời nhũ của mình: Những gì mình làm được bạn sẽ làm được trong thời gian ngắn hơn. Vì bạn có GPE.COM bên cạnh, còn mình trước đây thì không, cả internet lẫn GPE.COM! hì, hì, . . .)

Chúc bạn thành công!
 
(Vì trước sau gì bạn cũng trãi qua VBA, đừng chối bỏ nó, tội nghiệp mà!
Lời nhũ của mình: Những gì mình làm được bạn sẽ làm được trong thời gian ngắn hơn. Vì bạn có GPE.COM bên cạnh, còn mình trước đây thì không, cả internet lẫn GPE.COM! hì, hì, . . .)

Chúc bạn thành công!
Anh HYen17 nói đúng đấy bạn QuocPhong à!
Trước đây mình cũng từng thấy ngại khi tiếp xúc với VBA, nhưng được sự dẩn dắt của các đàn anh đi trước, mình tự nhủ phải cố gắng (vì lý nào người khác làm được mà mình thì lại không thể).. Đến khi tự tay làm được 1 bài (đơn giản nhất) lại thấy vô cùng hứng thú...
Bạn cũng hãy bắt đầu với VBA bằng công việc Record macro đi, rồi sẽ có lúc bạn không thể.. rứt nó ra được nữa
(Sorry vì tản mạn 1 tí)
-------------------------------
Nói riêng với QuocPhong: Mình vừa xem xong file mới nhất của bạn! Đến đoạn này thì mình chịu chết thật, chẳng hiểu cái gì trong đó (có lẽ không chuyên ngành) ---> Đành nhờ các sư phụ khác giúp 1 tay thôi! Hic...
 
HYen17 đã viết:
(Vì trước sau gì bạn cũng trãi qua VBA, đừng chối bỏ nó, tội nghiệp mà!
Lời nhũ của mình: Những gì mình làm được bạn sẽ làm được trong thời gian ngắn hơn. Vì bạn có GPE.COM bên cạnh, còn mình trước đây thì không, cả internet lẫn GPE.COM! hì, hì, . . .)

Chúc bạn thành công!
Anh HYen17 nói đúng đấy bạn QuocPhong à!
Trước đây mình cũng từng thấy ngại khi tiếp xúc với VBA, nhưng được sự dẩn dắt của các đàn anh đi trước, mình tự nhủ phải cố gắng (vì lý nào người khác làm được mà mình thì lại không thể).. Đến khi tự tay làm được 1 bài (đơn giản nhất) lại thấy vô cùng hứng thú...
Bạn cũng hãy bắt đầu với VBA bằng công việc Record macro đi, rồi sẽ có lúc bạn không thể.. rứt nó ra được nữa

Cám ơn những lời động viên của 2 bạn. Mình sẽ cố gắng. Nhưng xem code của 2 bạn thật sự mình chỉ hơi mù mờ hiểu thôi. Nhờ các bạn giải thích dùm mình thêm 1 chút ý nghĩa của đoạn code sau:
PHP:
...     Range("B8").Resize(24, 6).Value = .Offset((Target - 1) * 24 + 1, 1).Resize(24, 6).Value
    End With
    With Range("B7").CurrentRegion
      If .Rows.Count > 1 Then
        .Resize(, 1).SpecialCells(4).Value = Evaluate("ROW(R1:R1000)")
 
Cám ơn những lời động viên của 2 bạn. Mình sẽ cố gắng. Nhưng xem code của 2 bạn thật sự mình chỉ hơi mù mờ hiểu thôi. Nhờ các bạn giải thích dùm mình thêm 1 chút ý nghĩa của đoạn code sau:
PHP:
...     Range("B8").Resize(24, 6).Value = .Offset((Target - 1) * 24 + 1, 1).Resize(24, 6).Value
    End With
    With Range("B7").CurrentRegion
      If .Rows.Count > 1 Then
        .Resize(, 1).SpecialCells(4).Value = Evaluate("ROW(R1:R1000)")
- Vùng.Resize(x,y) có nghĩa là từ Vùng mở rộng x dòng và y cột
- Vùng.Offset(x,y) có nghĩa là từ Vùng, ta dịch đi x dòng và y cột
2 món ngày giống hàm OFFSET của Excel ấy
- Target chính là cell mà bạn gõ hoặc chọn bằng Validation gì đó
- Cell nào đó.CurrentRegion tương đương với việc bạn chọn Cell nào đó rồi bấm tổ hợp phím Ctrl + Shift + *
- Evaluate("ROW(R1:R1000)") tương đương với việc bạn quét chọn 1 dảy cell dọc (chẳng hạn là B5:B15) rồi gõ vào thanh Formula công thức mãng =ROW(R1:R1000) ---> Cái này để tạo số thứ tự ấy mà
Nói về With... End With
Cái này giống như trong toán học người ta đặt thành thừa số chung vậy! Ví dụ:
PHP:
Sub Test()
  Range("A1:A10").Font.Size = 10
  Range("A1:A10").Interior.ColorIndex = 5
  Range("A1:A10").Font.Bold = True
End Sub
Ở đây ta thấy Range("A1:A10") lập đi lập lại nhiều lần, vậy đặt nó làm "thừa số chung" bằng With... End With như sau:
PHP:
Sub Test()
  With Range("A1:A10")
    .Font.Size = 10
    .Interior.ColorIndex = 5
    .Font.Bold = True
  End With
End Sub
Đờ mất công gõ đi gõ lại nhiều lần
Sơ bộ vài nét thế... hy vọng bạn tự nghiên cứu thêm và ngày càng tiến bộ
 
Nhờ bạn giải thích thêm cho mình phần này:
PHP:
If .Rows.Count > 1 Then
        .Resize(, 1).SpecialCells(4).Value = Evaluate("ROW(R1:R1000)")
Mình không hiểu cách gán số thứ tự lắm.
 
Nhờ bạn giải thích thêm cho mình phần này:
PHP:
If .Rows.Count > 1 Then
        .Resize(, 1).SpecialCells(4).Value = Evaluate("ROW(R1:R1000)")
Mình không hiểu cách gán số thứ tự lắm.
Đầu tiên là .SpecialCells(4)
Nó dùng để xác định các cell rổng!
Thử tưởng tượng tình huống thế này:
- Khi bạn chạy code thì đầu tiên nó sẽ xóa toàn bộ dử liệu củ, điền dử liệu mới vào tính từ cột thứ 2 (cột thứ nhất là STT vẫn đang trống)
- Tại thời điểm này, nếu quét chọn dử liệu, bấm Ctrl + G\Special\Blanks sẽ chọn toàn bộ các cell rổng, chính là các cell tại cột 1 ---> Trong code, thao tác này tương đương với Vùng chon.SpecialCells(4)
-
Chọn được các cell rổng thì tiếp theo điền số thứ tự vào thôi (bằng Evaluate("ROW(R1:R1000)") )
- Tuy nhiên, có trường hợp khi chạy code, không có dử liệu nào được lọc ra, tức vùng lọc chỉ có tiêu đề, hoàn toàn không có tí dử liệu nào bên dưới ---> Khi ấy Vùng chon.SpecialCells(4) sẽ bị lổi ngay, đúng không? (không tìm thấy cell rổng nào)
Chính vì lẽ đó mà phải ràng buột điều kiện: Vùng chọn có số dòng > 1 thì mới điền số thứ tự (If .Rows.Count > 1 Then)
Chú ý:
Ta thêm .Resize(, 1) vào đàng trước cho chắc ăn, để "thu nhỏ" vùng chọn thành 1 cột, chính là cột đầu tiên ---> Vì sợ rằng trong vùng dử liệu lọc, ngoài cột đầu tiên có cell rổng còn có các cột khác cũng chứa cell rổng ---> Khi ấy nó điền STT tầm bậy!
Đơn giản thế thôi!
 
Cám ơn bạn. Khi dùng VBA để lọc ra các môn chuyên thì sẽ không nhập được kết quả điểm thi như vậy mình chọn giải pháp clà tách riêng các môn chuyên ra từng sheet và đặt tên vùng tương ứng với từng môn. Ở sheet Phongthi, tại ô F3 mình tạo 1 list chứa tên vùng (VD: TOAN,LY,HOA,...). Nhờ bạn giúp mình làm thế nào để khi chọn tên vùng tại ô F3 thì các tên sheet và tên vùng có trong code sẽ thay đổi theo.
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$F$2" Then
    Range("A7:G30").ClearContents
    With ThisWorkbook.Names("TOAN").RefersToRange
      Range("B7").Resize(24, 6).Value = .Offset((Target - 1) * 24, 0).Resize(24, 6).Value
    End With
    With Range("B6").CurrentRegion
      If .Rows.Count > 1 Then
        .Resize(, 1).SpecialCells(4).Value = Evaluate("ROW(R1:R24)")
      End If
    End With
  End If
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Cám ơn bạn. Khi dùng VBA để lọc ra các môn chuyên thì sẽ không nhập được kết quả điểm thi như vậy mình chọn giải pháp clà tách riêng các môn chuyên ra từng sheet và đặt tên vùng tương ứng với từng môn. Ở sheet Phongthi, tại ô F3 mình tạo 1 list chứa tên vùng (VD: TOAN,LY,HOA,...). Nhờ bạn giúp mình làm thế nào để khi chọn tên vùng tại ô F3 thì các tên sheet và tên vùng có trong code sẽ thay đổi theo.
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$F$2" Then
    Range("A7:G30").ClearContents
    With ThisWorkbook.Names("TOAN").RefersToRange
      Range("B7").Resize(24, 6).Value = .Offset((Target - 1) * 24, 0).Resize(24, 6).Value
    End With
    With Range("B6").CurrentRegion
      If .Rows.Count > 1 Then
        .Resize(, 1).SpecialCells(4).Value = Evaluate("ROW(R1:R24)")
      End If
    End With
  End If
End Sub
Chỉ cần sửa đoạn:
With ThisWorkbook.Names("TOAN").RefersToRange
thành:
With ThisWorkbook.Names(Range("F3").Value).RefersToRange
Hoặc đơn giản hơn:
With Evaluate(Range("F3").Value)
là xong
Tuy nhiên vẫn chưa hay, vì khi ta thay đổi F3, lại phải thay đổi F2 thì code mới chạy
Sửa lại cho hoàn hảo hơn (thay đổi F2 hay F3 thì code cũng chạy)
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
  With Range("F2:F3")
    If Not Intersect(.Cells, Target) Is Nothing Then
      Range("A7:G30").ClearContents
      With Evaluate(.Cells(2, 1).Value).Offset((.Cells(1, 1) - 1) * 24, 0).Resize(24, 6)
        Range("B7").Resize(24, 6).Value = .Value
      End With
      With Range("B6").CurrentRegion
        If .Rows.Count > 1 Then
          .Resize(, 1).SpecialCells(4).Value = Evaluate("ROW(R1:R24)")
        End If
      End With
    End If
  End With
End Sub
 
Lần chỉnh sửa cuối:
Web KT

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

Back
Top Bottom