Chỉ giữ lại điểm cao nhất !

Liên hệ QC

Buck

Thành viên mới
Tham gia
19/3/07
Bài viết
22
Được thích
34
Cho em xin hỏi các bác cái nhé!
File Bảng điểm có tên sinh viên, mỗi môn học có các điểm tương ứng với các lần thi (Thi đi, thi lại các lần). Ví dụ: Môn 1: 3;4;5
Bây giờ em muốn: Chuyển bảng điểm ở Sheet này sang một sheet hoặc file mới với điều kiện: chỉ giữ lại điểm cao nhất (3;4;5 thì lấy 5)
Nhưng nếu thủ công chỉnh sửa thì lâu quá với hàng nghìn SV.
Mong các bác chỉ giúp em cách làm nhanh, có sử dụng VBA cũng được em sẽ tự nghiên cứu cho hiểu ( chả là em đang nghiên cứu cuốn sách của bác Hướng)
Mong sự giúp đỡ của các bác nhiều !!!
 

File đính kèm

  • BangDiem.rar
    8 KB · Đọc: 54
Lần chỉnh sửa cuối:
Buck đã viết:
Cho em xin hỏi các bác cái nhé!
File Bảng điểm có tên sinh viên, mỗi môn học có các điểm tương ứng với các lần thi (Thi đi, thi lại các lần). Ví dụ: Môn 1: 3;4;5
Bây giờ em muốn: Chuyển bảng điểm ở Sheet này sang một sheet hoặc file mới với điều kiện: chỉ giữ lại điểm cao nhất (3;4;5 thì lấy 5)
Nhưng nếu thủ công chỉnh sửa thì lâu quá với hàng nghìn SV.
Mong các bác chỉ giúp em cách làm nhanh, có sử dụng VBA cũng được em sẽ tự nghiên cứu cho hiểu ( chả là em đang nghiên cứu cuốn sách của bác Hướng)
Mong sự giúp đỡ của các bác nhiều !!!

Chào bạn

Bạn dùng hàm tự tạo sau:

Function GetMaxFromText(txt As String, separator As String) As Integer
Dim allitem As Variant
Dim iitem
Dim maxitem As Integer
maxitem = 0
allitem = Split(txt, separator)
For Each iitem In allitem
If maxitem < Int(iitem) Then maxitem = Int(iitem)
Next
GetMaxFromText = maxitem
End Function

Xem thêm file đính kèm (Alt+F11 xem hàm)
 

File đính kèm

  • BangDiem.zip
    16.5 KB · Đọc: 42
Tìm chữ số lớn nhất trong ô

Dây là thủ tục theo yêu cầu của bạn. Trong tập tin Bangdiem.rar
Mã:
Sub DiemMax()
Application.DisplayAlerts = False
Dim xMax As Object, xDiem As Object
Set xDiem = ThisWorkbook.Sheets("Diem")
xDiem.Copy After:=xDiem
a = 0
b = 0
Set xMax = ActiveSheet
r = 4
Do
For c = 4 To 35
If Cells(r, c) <> "" Then
vt = 1
diem = Cells(r, c) & ";"
vt1 = InStr(1, diem, ";")
If vt1 > 0 Then
diem1 = Val(Mid(diem, vt, vt1 - vt))
vt = vt1 + 1
Do
vt1 = InStr(vt, diem, ";")
a = 0
If vt1 > 0 Then
diem2 = Val(Mid(diem, vt, vt1 - vt))
vt = vt1 + 1
If diem1 < diem2 Then diem1 = diem2
Else
Cells(r, c) = diem1
Exit Do
End If
b = 0
a = 0
Loop
End If
End If
Next
r = r + 1
If Cells(r, 1) = "" Then Exit Do
Loop
End Sub
 

File đính kèm

  • BangDiem.rar
    16.6 KB · Đọc: 41
Cảm ơn các bác nhiều quá !
Cho em hỏi bác ttphong2007 nếu làm theo kiểu của bác thì có thể sử dụng công thức đó qua bên sheet khác và quét cả vùng được không ạ. Nếu không cứ làm từng ô thì cũng mệt lắm.
Và em cũng xin hỏi bác phamduylong là: cứ mỗi một bảng điểm của một lớp khác nhau với số dòng (r) và số cột (c) khác nhau trong vùng chứa điểm thì ta lại phải thay đổi lại code cho phù hợp. Vậy bác có cách nào mà với bất kỳ bảng điểm nào có số r và c khác nhau nhưng nó vẫn tự động tính được.
Em đang trong quá trình học hỏi nên hỏi các bác hơi nhiều, mong các bác giúp cho ạ. Em cảm ơn !!!
 
Buck đã viết:
Cảm ơn các bác nhiều quá !
Cho em hỏi bác ttphong2007 nếu làm theo kiểu của bác thì có thể sử dụng công thức đó qua bên sheet khác và quét cả vùng được không ạ. Nếu không cứ làm từng ô thì cũng mệt lắm.

Công thức đó sử dụng như các công thức khác của Excel thôi do vậy bạn sử dụng ở đâu cũnf được, bạn nhấn Alt+F11 và thêm dòng lệnh sau vào dưới khai báo hàm:


Application.Violate True

TP.
 
Có 1 cách đơn giản nữa mà ko cần dùng đến macro. Đó là sử dụng công cụ Text to Columns (trong menu Data). Theo cách làm này thì tôi sẽ tách cell chứa dử liệu: 2;3;6 thành 5 cột: 2 ; 3 ; 6
Khi tách cột ra xong thì chọn tất cả các cột chứa dấu ";" rồi xóa đi. Save as thành file mới. Mở file mới này ra, rồi copy dử liệu vào sheet2 của file củ. Như vậy bạn vẫn giữ dc tất cả điểm của các lần thi. Muốn lấy điễm lớn nhất thì dùng hàm MAX là xong.Tôi đã làm thử và thấy ko có vấn đề gì cả.
Miss TT
 
Nhờ thanhtri hướng dẫn qua cách làm text to column được không, tôi hiểu ý tưởng của bạn jồi nhưng làm text to column mãi mà không được.
Cảm ơn nhiều nhé
 
Dùng Text to Column thì hay nhưng chỉ làm từng cột 1 và phải chèm thêm 2 cột trống bên cạnh để lấy 3 lần điểm
Tôi sẽ tách cell chứa dử liệu: 2;3;6 thành 5 cột: 2 ; 3 ; 6
Không phải tách 2;3;6 thành 5 cột mà chỉ 3, trong bước 2 bạn chọn other và nhập vào ký tự ";" thì nó sẽ cho 3 cột thôi.
 
Tôi chỉ mới thử qua và biết chắc chắn là làm dc thôi, vì trứơc giờ ko có chuyện gì cần dùng đến. Còn chi tiết thế nào cứ việc hỏi 2 cao thủ Hiếu và ThuNghi. Tôi thấy cái vụ Text to Column cũng ko khó lắm mà. Ráng đọc tiếng Anh và hiểu nó muốn nói gì sẽ làm dc ngay!
Miss TT
 
Cảm ơn tất cả các bác, em cũng đã làm được rồi. Nhưng em thấy cũng vẫn hơi mất thời gian một chút. Chương trình của bác Phamduylong hay ghê. Em tự mày mò thêm và áp dụng được vào một số File khác rồi. Cảm ơn bác nhiều.
Nói chung em cảm ơn tất cả mọi người đã chỉ bảo em nhiều.
 
Buck đã viết:
Cảm ơn các bác nhiều quá !
Và em cũng xin hỏi bác phamduylong là: cứ mỗi một bảng điểm của một lớp khác nhau với số dòng (r) và số cột (c) khác nhau trong vùng chứa điểm thì ta lại phải thay đổi lại code cho phù hợp. Vậy bác có cách nào mà với bất kỳ bảng điểm nào có số r và c khác nhau nhưng nó vẫn tự động tính được.
Muốn sử dụng DiemMax cho một các lớp khác nhau về số dòng và số cột trong vùng chứa điểm, sheet chứa dữ liệu phải có dấu hiệu nhận dạng. Với ví dụ của Buck, tôi xác định dòng cuối, cột cuối bằng cách:
- Phía dưới dòng cuối cùng cột STT (cột A) phải có ít nhất 1 ô trống để câu lệnh
dongcuoi = Range("A4").End(xlDown).Row gán dòng cuối vào biến dongcuoi.
- Phía bên phải cột cuối bảng điểm còn nhiều cột điểm khác nên không xác định như dongcuoi được. Tôi xác định bằng cách tìm cột phía trước của ô có nội dung “TBC”:
cotcuoi = Cells.Find(What:="TBC", After:=Cells(1, 1)).Column – 1
Lưu ý bạn:
1. Nếu có 1 điểm có các ký tự khác mà Excel không hiểu là số thì DiemMax báo lỗi và chỉ ngay vào ô gây lỗi để bạn chỉnh lại.
2. Nếu bạn nhập 2;,8 (định dạng VN) hoặc 2;.8 (định dạng US) thì DiemMax hiểu là 2; 0,8 và cho kết quả là 2.

Tôi viết lại DiemMax theo yêu cầu trên và có chỉnh cú pháp lại cho gọn hơn.

Mã:
Sub DiemMax()
On Error GoTo baoloi
Application.DisplayAlerts = False
Dim xMax As Object, xDiem As Object
Set xDiem = ThisWorkbook.Sheets("Diem")
xDiem.Copy After:=xDiem
Set xMax = ActiveSheet
dongcuoi = Range("A4").End(xlDown).Row
cotcuoi = Cells.Find(What:="TBC", After:=Cells(1, 1)).Column - 1
For r = 4 To dongcuoi
For c = 4 To cotcuoi
If Cells(r, c) <> "" Then
diem = Cells(r, c) & ";"
diem1 = 0
vt = InStr(1, diem, ";")
Do While vt > 0
diem2 = Left(diem, vt - 1)
If diem1 < diem2 Then diem1 = diem2
diem = Mid(diem, vt + 1)
vt = InStr(1, diem, ";")
Loop
Cells(r, c) = diem1
End If
Next
Next
Exit Sub
baoloi:
xMax.Delete
xDiem.Select
Cells(r, c).Select
MsgBox "Nhap diem sai!"
End Sub

(Lần sau bạn nên viết lệnh trong tag
Mã:
)[/SIZE]
 

File đính kèm

  • BangDiemMax.zip
    18.3 KB · Đọc: 14
Chỉnh sửa lần cuối bởi điều hành viên:
Web KT
Back
Top Bottom