Nhờ góp ý và thu gọn code tính điểm. (8 người xem)

[Ba Tê]

Tôi vừa xem được quyển "Lập trình VBA trong Excel", thử viết thử một SUB, rất mong các Bạn "kỳ cựu VBA" rút gọn lại cho tối ưu nhất.
Thêm nữa, nhờ các Bạn góp ý: Nếu Bảng tính này có khoảng 15 sheet như thế, mỗi sheet là một môn, mỗi sheet khoảng 2500-3000 dòng thì có cách nào "tốt" nhất không, nhờ các Bạn góp ý - Đây chỉ là ý tưởng, mọi góp ý xây dựng ý tưởng đều rất trân trọng, không ngại phá bỏ biểu mẫu có sẵn.
Thành thật cảm ơn các Bạn!
-----------
Tôi nghĩ đây là chuyện tính điểm của GD, nếu sai Box, xin BQT chuyển đến vị trí thích hợp, thành thật cảm ơn.
Ba Tê.

 

[SA_DQ]

Ba Tê thử kiểm tra macro này xem sao

Option Explicit
Public Sub GPE()
Dim Dong, myCount As Long
Dim MyRange As Range, Sh As Worksheet, Rng As Range

Application.ScreenUpdating = False
Set Sh = Worksheets("Toan")
Set MyRange = Worksheets("Toan").Range("A5:A2000")
With Application.WorksheetFunction
   myCount = .CountA(MyRange)
   Dong = 5
   Do While Dong <= myCount + 5
'- - - - - - - - - - - - Tinh Diem TB Hoc Ky 1'
      Set Rng = Sh.Range("F" & Dong & ":Q" & Dong)
      If .Count(Rng) = 0 Then
         Sh.Range("AD" & Dong) = ""
      Else
         Sh.Range("AD" & Dong) = Round(.Average(Rng, _
            Sh.Range("L" & Dong & ":Q" & Dong), Sh.Range("Q" & Dong)), 1)
      End If
'- - - - - - - - - - - - Tinh Diem TB Hoc Ky 2'
      Set Rng = Sh.Range("R" & Dong & ":AC" & Dong)
      If .Count(Rng) = 0 Then
         Sh.Range("AE" & Dong) = ""
      Else
         Sh.Range("AE" & Dong) = Round(.Average(Rng, _
            Sh.Range("X" & Dong & ":AC" & Dong), Sh.Range("AC" & Dong)), 1)
      End If
'- - - - - - - - - - - - Tinh Diem TB Ca Nam'
      If Sh.Range("AD" & Dong) = "" Or Sh.Range("AE" & Dong) = "" Then
         Sh.Range("AF" & Dong) = ""
      Else
         Sh.Range("AF" & Dong) = Round(((Sh.Range("AE" & Dong) * 2) + Sh.Range("AD" & Dong)) / 3, 1)
      End If
'- - - - - - - - - - - -'
      Dong = Dong + 1
   Loop
End With
Application.ScreenUpdating = True
End Sub

Ngoài ra ta còn thấy cách tính điểm HK I & HK II tương tợ nhau. Đã vậy ta có thể ghi ra 1 macro riêng & cung cấp cho macro này các tham số vùng ô tính cần thiết. (Tất nhiên, chuyện này chỉ mang tính học thuật)

Mệnh đề kiểu này

Sh.Range("L" & Dong & ":Q" & Dong)

trong các câu lệnh có thể thay bằng Sh.Cells(Dong,"L").Resize(,6)
Nhưng fương thức Resize(x,y) ta từ từ rồi sẽ nhừ sau!

Chúc thành công.

 

[SA_DQ]

Thấy cần fải hướng Ba Tê sang đường khác, an toàn hơn: Đó là hàm tự tạo

Option Explicit
Function DiemHK(HS1 As Range, HS2 As Range, Optional Thi As Range, Optional HKy As Boolean = True)
 Dim Rng As Range
 
 If HKy Then
   Set Rng = Union(HS1, HS2, Thi)
   With Application.WorksheetFunction
      If .Count(Rng) > 0 Then _
         DiemHK = Round(.Average(Rng, Union(HS2, Thi), Thi), 1)
   End With
 Else
   If HS1.Value = "" Or HS2.Value = "" Then
      DiemHK = ""
   Else
      DiemHK = Round((2 * HS2.Value + HS1.Value) / 3, 1)
   End If
 End If
End Function

Cú fáp dùng hàm để tính điểm học kì I là: =diemHK(F5:K5,L55,Q5) (cho em HS đang ở dòng 5)

Cú fáp dùng hàm để tính điểm học kì II là: =diemHK(R5:W5,X5:AB5,AC5) (cho em HS đang ở dòng 5)

& cuối cùng tính điểm trung bình cả năm của em í cú fáp sẽ là: =diemHK(AD5,AE5,,FALSE) (Chú í tìm hiểu chỗ được tô đỏ nha!)

Sao nói an toàn hơn: Vì khi sửa điểm trong bảng, hàm sẽ được cập nhật số liệu Automatic, khỏi quên hỉ!

 

[ThuNghi]

Tôi vừa xem được quyển "Lập trình VBA trong Excel", thử viết thử một SUB, rất mong các Bạn "kỳ cựu VBA" rút gọn lại cho tối ưu nhất.
Thêm nữa, nhờ các Bạn góp ý: Nếu Bảng tính này có khoảng 15 sheet như thế, mỗi sheet là một môn, mỗi sheet khoảng 2500-3000 dòng thì có cách nào "tốt" nhất không, nhờ các Bạn góp ý - Đây chỉ là ý tưởng, mọi góp ý xây dựng ý tưởng đều rất trân trọng, không ngại phá bỏ biểu mẫu có sẵn.
Thành thật cảm ơn các Bạn!
-----------

Anh có thể cho em biết các môn còn lại cấu trúc sh có giống như môn toán? Nếu giống như vậy em nghĩ rằng code của anh là khá chuẩn rồi. Lúc này em thích dùng vòng lặp và dùng WorksheetFunction thấy nhanh hơn
Range(...).FormulaR1C1
Hay Anh dùng Sub kết hợp UDF của Bác Sa cũng OK.
Để em dùng code của Anh gán vào array thử nhé, xem có nhanh hơn.
Anh dùng thử code sau thử, ok thì bỏ dòng tính time. Có lập sẵn để anh triển khai nhiều sh.

Option Explicit
Option Base 1
Dim nDong As Long, endR As Long, k As Long
Dim iMon As Long
Dim shName As String
Dim WF As WorksheetFunction
Dim HS1 As Range, HS2 As Range, Thi As Range
Const fR As Long = 5
Sub TinhDiem()
Dim Arr() As Variant
Dim MonArr
Dim t As Variant
t = Timer
MonArr = Array("Toan", "Van", "Ly")
Set WF = WorksheetFunction
With Application
  .ScreenUpdating = False: .Calculation = xlCalculationManual
End With
'For iMon = 1 To 1 'UBound(MonArr)
  shName = MonArr(1)
  With Sheets(shName)
    endR = .Cells(65000, 1).End(xlUp).Row
    ReDim Arr(endR - fR + 1, 3)
    k = 1
    For nDong = 1 To endR - fR + 1
      'diem HK1'
      k = nDong + 4
      Set HS1 = .Range("F" & k & ":K" & k)
      Set HS2 = .Range("L" & k & ":P" & k)
      If WF.Count(HS1) = 0 Or WF.Count(HS2) = 0 Then
        Arr(nDong, 1) = ""
        Arr(nDong, 2) = ""
        Arr(nDong, 3) = ""
        GoTo bien
      End If
      Set Thi = .Range("Q" & k & ":Q" & nDong)
      Arr(nDong, 1) = DiemHK(HS1, HS2, Thi)
      'diem HK2'
      Set HS1 = .Range("R" & k & ":W" & k)
      Set HS2 = .Range("X" & k & ":AB" & k)
      If WF.Count(HS1) = 0 Or WF.Count(HS2) = 0 Then
        Arr(nDong, 1) = ""
        Arr(nDong, 2) = ""
        Arr(nDong, 3) = ""
        GoTo bien
      End If
      Set Thi = .Range("AC" & k & ":AC" & nDong)
      Arr(nDong, 2) = DiemHK(HS1, HS2, Thi)
      Arr(nDong, 3) = Round((2 * Arr(nDong, 1) + Arr(nDong, 2)) / 3, 1)
bien:
  Next nDong
    'gan vao'
    .Range("AD" & fR & ":AF" & endR) = Arr
    Cells(5, 34) = Timer - t
  End With
'Next iMon'
Set WF = Nothing
Set HS1 = Nothing
Set HS2 = Nothing
Set Thi = Nothing
With Application
  .ScreenUpdating = True: .Calculation = xlCalculationAutomatic
End With
End Sub
Function DiemHK(HS1 As Range, HS2 As Range, Optional Thi As Range)
Dim Rng As Range
Set Rng = Union(HS1, HS2, Thi)
DiemHK = Round(WF.Average(Rng, Union(HS2, Thi), Thi), 1)
Set Rng = Nothing
End Function

Anh test xem. cám ơn anh.

 

[Ba Tê]

Anh có thể cho em biết các môn còn lại cấu trúc sh có giống như môn toán? Nếu giống như vậy em nghĩ rằng code của anh là khá chuẩn rồi. Lúc này em thích dùng vòng lặp và dùng WorksheetFunction thấy nhanh hơn
Range(...).FormulaR1C1
Hay Anh dùng Sub kết hợp UDF của Bác Sa cũng OK.
Để em dùng code của Anh gán vào array thử nhé, xem có nhanh hơn.
Anh dùng thử code sau thử, ok thì bỏ dòng tính time. Có lập sẵn để anh triển khai nhiều sh.
Anh test xem. cám ơn anh.

Tôi chưa hiểu cách dùng này, xin thông cảm vì mới chập chững vào VBA.
Ý tưởng của tôi là tạo khoảng 15 sheet, mỗi sheet là một môn học: Toán, Lý, Hóa, Sinh, Tin, Văn, Sử, Địa, Anh, GDCD, Công Nghệ, GDQP, Thể Dục, Tổng hợp, Thống kê... cho khoảng 40 lớp - 2000 học sinh.
Dùng hàm cho từng ô chắc máy sẽ chạy "cà giật" mỗi khi nhập liệu.
Tôi đang phân vân 3 cách: dùng Sub để tính mỗi sheet như sheet Toán hiện giờ, hay dùng Sub tính một loạt cả Worksheet, hay dùng hàm rồi làm Sub để khi mở tập tin thì chuyển máy tính sang chế độ Calculation manual, chỉ tính toán khi bấm vào một Command button, tính xong trở lại Calculation manual, đến khi đóng tập tin thì trả về Calculation Automatic, không biết cách nào là tốt nhất, nhờ các Bạn góp ý tiếp.

 

[ThuNghi]

Em gán code trên vào file, anh test lại nhé, chỉ cần nhấn nút "Tinh Diem" thì nó sẽ tính điểm TB 12 sh (12 môn).
Em dùng sub TinhDiem tính 1 lúc luôn cho khỏe.
Nếu các môn có số cột như nhau (cùng cấu trúc) thì dùng code trên, Còn nếu khác nhau thì em sẽ làm thêm 1 UDF để gán số cột.

 

[Ba Tê]

Em gán code trên vào file, anh test lại nhé, chỉ cần nhấn nút "Tinh Diem" thì nó sẽ tính điểm TB 12 sh (12 môn).
Em dùng sub TinhDiem tính 1 lúc luôn cho khỏe.
Nếu các môn có số cột như nhau (cùng cấu trúc) thì dùng code trên, Còn nếu khác nhau thì em sẽ làm thêm 1 UDF để gán số cột.

Đã biết cách làm rồi, Cảm ơn Bạn ThuNghi, nhưng do chưa hiểu rành lắm về cấu trúc các câu lệnh nên chưa chỉnh được, nhờ Bạn xem hộ tại sao các Học sinh này điểm số giống nhau nhưng kết quả lại khác nhau? Cảm ơn Bạn.

 

[ThuNghi]

Đã biết cách làm rồi, Cảm ơn Bạn ThuNghi, nhưng do chưa hiểu rành lắm về cấu trúc các câu lệnh nên chưa chỉnh được, nhờ Bạn xem hộ tại sao các Học sinh này điểm số giống nhau nhưng kết quả lại khác nhau? Cảm ơn Bạn.

Chờ em kiểm tra lại, chưa biết sai chỗ nào.
Em chạy lại mà kg thấy sai. Lúc đầu chạy thấy sai, em thử đónh excel và mở lại thì hết.

 

[Ba Tê]

Chờ em kiểm tra lại, chưa biết sai chỗ nào.
Em chạy lại mà kg thấy sai. Lúc đầu chạy thấy sai, em thử đónh excel và mở lại thì hết.

Điểm TB cả năm = (TB HK2*2 + TBHK1)/3, tôi đã chỉnh lại dòng này không biết có đúng không?

Arr(nDong, 3) = Round((2 * Arr(nDong, 1) + Arr(nDong, 2)) / 3, 1)
thành:
Arr(nDong, 3) = Round((2 * Arr(nDong, 2) + Arr(nDong, 1)) / 3, 1)

Tôi cho chạy thử vẫn sai kết quả,
Mong Bạn kiểm tra tiếp.

 

[ThuNghi]

Điểm TB cả năm = (TB HK2*2 + TBHK1)/3, tôi đã chỉnh lại dòng này không biết có đúng không?

Arr(nDong, 3) = Round((2 * Arr(nDong, 1) + Arr(nDong, 2)) / 3, 1)
thành:
Arr(nDong, 3) = Round((2 * Arr(nDong, 2) + Arr(nDong, 1)) / 3, 1)

Mong Bạn kiểm tra tiếp.

Đúng rồi Anh à,
Arr này có 3 cột: HK1, HK2, CN tương đương
Arr(nDong,i) i =1,2,3
Cái vụ array này em học trên GPE và nhờ Bác PTM gợi ý làm theo cách array để cải thiện tốc độ.
Em cũng thấy nó nhanh thật.

 

[Ba Tê]

Đúng rồi Anh à,
Arr này có 3 cột: HK1, HK2, CN tương đương
Arr(nDong,i) i =1,2,3
Cái vụ array này em học trên GPE và nhờ Bác PTM gợi ý làm theo cách array để cải thiện tốc độ.
Em cũng thấy nó nhanh thật.

Nhờ Bạn xem lại dùm tập tin kèm ở bài #9, tôi thấy nó vẫn tính các Học sinh không giống nhau.

 

[ThuNghi]

Nhờ Bạn xem lại dùm tập tin kèm ở bài #9, tôi thấy nó vẫn tính các Học sinh không giống nhau.

Xin lỗi anh nhiều, n1 sai có quy luật là 4 dòng, em tìm ra lý do là cl ở k và Ndong
Anh sửa đoạn sau trong code giúp em

Set Thi = .Range("Q" & k & ":Q" & nDong)

Thành

Set Thi = .Range("Q" & k )

Tương tự

Set Thi = .Range("AC" & k & ":AC" & nDong)

thành

Set Thi = .Range("AC" & k )

Vừa dư lại sai, do em sửa biên k mà quên.

 

[Ba Tê]

Ổn rồi, thử mỗi sheet 2000 dòng, 13 sheet, chạy 2,6 giây, quá tuyệt.
Cảm ơn ThuNghi nhiều, còn phần sau mai mốt giúp tiếp nhé.

 

[ndu96081631]

Ổn rồi, thử mỗi sheet 2000 dòng, 13 sheet, chạy 2,6 giây, quá tuyệt.
Cảm ơn ThuNghi nhiều, còn phần sau mai mốt giúp tiếp nhé.

Với dữ liệu được bố trí như file của bạn, tôi sẽ dùng code này:

Sub TinhDiem(Diem As Range)
  Application.ScreenUpdating = False
  On Error Resume Next
  With Diem.Resize(, 1).Offset(, Diem.Columns.Count)
    .Resize(, 3).ClearContents
    .Offset(, 0).FormulaR1C1 = "=IF(COUNT(RC[-24]:RC[-13])=0,"""",ROUND(AVERAGE(RC[-24]:RC[-13],RC[-18]:RC[-13],RC[-13]),1))"
    .Offset(, 1).FormulaR1C1 = "=IF(COUNT(RC[-13]:RC[-2])=0,"""",ROUND(AVERAGE(RC[-13]:RC[-2],RC[-7]:RC[-2],RC[-2]),1))"
    .Offset(, 2).FormulaR1C1 = "=IF(OR(RC[-2]="""",RC[-1]=""""),"""",ROUND((RC[-2]+2*RC[-1])/3,1))"
    .Resize(, 3).Value = .Resize(, 3).Value
  End With
  Application.ScreenUpdating = True
End Sub

Sub Main()
  Dim Sh As Worksheet, TG As Double
  TG = Timer
  For Each Sh In ThisWorkbook.Worksheets
    If Sh.Name <> "TK_CL" And Sh.Name <> "TONGHOP" Then
      TinhDiem Sh.Range("F5:AC5000")
    End If
  Next Sh
  MsgBox Timer - TG
End Sub

Chạy Sub Main để tính cho toàn bộ các sheet
Thử xem tổng thời gian là bao nhiêu nhé
----------------------------------
Với cách viết code như trên, bạn có thể tùy thích tính toán cho 1 sheet hay cho toàn bộ các sheet

 

[ThuNghi]

Với dữ liệu được bố trí như file của bạn, tôi sẽ dùng code này:

Chạy Sub Main để tính cho toàn bộ các sheet
Thử xem tổng thời gian là bao nhiêu nhé
----------------------------------
Với cách viết code như trên, bạn có thể tùy thích tính toán cho 1 sheet hay cho toàn bộ các sheet[/QUOTE]
Mình đã gán 2 code vào chạy thử và nhận thấy dùng array có vẻ nhanh hơn.  NDU test giúp nhé.
Cơ bản tìm ra cách tối ưu mà.

 

[ndu96081631]

Mình đã gán 2 code vào chạy thử và nhận thấy dùng array có vẻ nhanh hơn. NDU test giúp nhé.
Cơ bản tìm ra cách tối ưu mà.

Cái này khỏi test cũng chắc như vậy rồi
Tôi cũng định làm nhưng.. hơi lười.. Ẹc.. Ẹc.. 2000 dòng dữ liệu ta dùng công thức rồi chuyển sang Value với mục đích cho code ngắn gọn thôi
Nói chung trong mọi trường hợp thì đặt kết quả tính toán vào 1 Array, sau khi xong việc ta gán Array này trở lại bảng tính là cách làm cho tốc độ nhanh nhất
(Có điều tôi nghĩ code của ThuNghi có thể rút gọn thêm được đấy)

 

[Ba Tê]

Mình đã gán 2 code vào chạy thử và nhận thấy dùng array có vẻ nhanh hơn. NDU test giúp nhé.
Cơ bản tìm ra cách tối ưu mà.

Cái này khỏi test cũng chắc như vậy rồi
Tôi cũng định làm nhưng.. hơi lười.. Ẹc.. Ẹc.. 2000 dòng dữ liệu ta dùng công thức rồi chuyển sang Value với mục đích cho code ngắn gọn thôi
Nói chung trong mọi trường hợp thì đặt kết quả tính toán vào 1 Array, sau khi xong việc ta gán Array này trở lại bảng tính là cách làm cho tốc độ nhanh nhất
(Có điều tôi nghĩ code của ThuNghi có thể rút gọn thêm được đấy)

Cảm ơn các Bạn. Tôi đã test thử 12 sheet, xảy ra trường hợp sau:
Mỗi sheet có 51 dòng: code ThuNghi chạy 0.0625 - code ndu chạy 0.5477
Mỗi sheet có 2000 dòng: code ThuNghi chạy 2.625 - code ndu chạy 0.5631
Có đặc điểm nào đó mà số lượng dòng trong mỗi sheet tăng lên rất nhiều mà code của ndu tốc độ (thấy trong Msgbox) vẫn gần như tương đương, tôi không hiểu được, các Bạn nghiên cứu nhé.

 

[ThuNghi]

Cảm ơn các Bạn. Tôi đã test thử 12 sheet, xảy ra trường hợp sau:
Mỗi sheet có 51 dòng: code ThuNghi chạy 0.0625 - code ndu chạy 0.5477
Mỗi sheet có 2000 dòng: code ThuNghi chạy 2.625 - code ndu chạy 0.5631
Có đặc điểm nào đó mà số lượng dòng trong mỗi sheet tăng lên rất nhiều mà code của ndu tốc độ (thấy trong Msgbox) vẫn gần như tương đương, tôi không hiểu được, các Bạn nghiên cứu nhé.

Sao lạ vậy nhỉ, thật sự code NDU nhanh hơn gần 10 lần với >2000 dòng.
Về logich thì thấy vô lý mà chưa nghĩ ra.
Cám ơn BaTê, cám ơn NDU.

 

[ndu96081631]

Cảm ơn các Bạn. Tôi đã test thử 12 sheet, xảy ra trường hợp sau:
Mỗi sheet có 51 dòng: code ThuNghi chạy 0.0625 - code ndu chạy 0.5477
Mỗi sheet có 2000 dòng: code ThuNghi chạy 2.625 - code ndu chạy 0.5631
Có đặc điểm nào đó mà số lượng dòng trong mỗi sheet tăng lên rất nhiều mà code của ndu tốc độ (thấy trong Msgbox) vẫn gần như tương đương, tôi không hiểu được, các Bạn nghiên cứu nhé.

Tôi tin rằng cách dùng Array sẽ luôn cho kết quả nhanh hơn ---> Test code của ThuNghi, nếu cho kết quả chậm hơn thì có chăng là do code ấy chưa được tối ưu ở 1 công đoạn nào đó mà thôi
Tuy nhiên, dữ liệu của bạn cũng không phải là nhiều lắm, vì vậy bạn hoàn toàn có thể lựa chọn phương pháp của tôi (tốc độ tạm chấp nhận nhưng code gọn hơn và dễ hiểu hơn)

 

[huuthang_bd]

Nói chung trong mọi trường hợp thì đặt kết quả tính toán vào 1 Array, sau khi xong việc ta gán Array này trở lại bảng tính là cách làm cho tốc độ nhanh nhất
(Có điều tôi nghĩ code của ThuNghi có thể rút gọn thêm được đấy)

Tôi nghĩ không hẳn là như vậy. Như trường hợp test code của Ba Tê

Cảm ơn các Bạn. Tôi đã test thử 12 sheet, xảy ra trường hợp sau:
Mỗi sheet có 51 dòng: code ThuNghi chạy 0.0625 - code ndu chạy 0.5477
Mỗi sheet có 2000 dòng: code ThuNghi chạy 2.625 - code ndu chạy 0.5631
Có đặc điểm nào đó mà số lượng dòng trong mỗi sheet tăng lên rất nhiều mà code của ndu tốc độ (thấy trong Msgbox) vẫn gần như tương đương, tôi không hiểu được, các Bạn nghiên cứu nhé.

Tôi nghĩ nguyên nhân là như thế này:
Code của ThuNghi tính toán từng kết quả một và gán vào một Array. Sau khi tính hết sẽ gán kết quả của Array vào Vùng kết quả. Nếu dữ liệu ít thì cách này nhanh hơn. Nhưng nếu dữ liệu lớn, biến bạn dùng để lưu kết quả tạm (Là Array bạn dùng để lưu kết quả) sẽ chiếm tài nguyên nhiều hơn. Run code mà phải nhớ một biến có dung lượng càng lớn thì tốc độ của code sẽ càng chậm.