Đúng rồi ạ. Ý em là muốn sửa code từ file ban đầu theo file này để e học. Nhưng sửa mãi ko thành. Nên e muốn nhờ tác giả code sửa để e so sánh, khi đó e sẽ hiểu code dễ hơn ạ. Đây đơn thuần chỉ là e muốn học thêm, còn nhu cầu của e thì file ban đầu là ok rồi.
Làm sao phân biệt được SV khác nhau nhưng trùng tên?
À ừ nhỉ. E chưa nghĩ đến trường hợp này. Khi đó thì phải thêm cột ngày sinh chẳng hạn ạ
thế nhỡ nó trùng luôn cả ngày sinh thì làm thế nào nữa
Nên có mã SV
Vâng ạ. Anh sửa giúp theo cả 2 hướng đc ko ạ. 1 là y nguyên như file em vừa gửi, 2 là thêm cái cột mã sv. Như vậy e sẽ biết thêm đc nhiều hơn.
Cột ngày và cột giờ thi nếu trùng điểm cao nhất sẽ rất khó nhìn, nên tính theo phương án khác
Có thể bỏ cái vụ trùng đi cũng đc ạ, nếu cao nhất thì chỉ lấy 1 thôi ạ.
Em đang ngồi hóng code của thầy
Dữ liệu chỉ 1 môn hay nhiều môn? Nếu nhiều môn thì sao?
Hiện tại em chỉ làm cho từng môn ạ. Từ cái code theo form mới này a giúp em, em sẽ cố gắng hiểu và mò để làm cho nhiều môn, nếu ko thể được em sẽ hỏi tiếp, như thế em sẽ học và nhớ đc lâu hơn ạ.
Xem code
Sub LargeNumeFilter()
Dim sArr(), Res(), Arr(), tmp
Dim sRow&, iRnk&, i&, k&, ik&, q&
Dim fDay As Date, eDay As Date, maSV$, Diem&
On Error Resume Next
With Sheet2
fDay = .Range("D1").Value 'Ngay dau
eDay = .Range("D2").Value 'Ngay cuoi
.Range("A5:E500").ClearContents 'Xoa ket qua
End With
If Err.Number > 0 Or fDay > eDay Then 'Kiem tra tinh hop le ngay xuat bao cao
MsgBox ("Xem lai dieu kien ngay thi Tu ... Den ...")
Err.Clear
Exit Sub
End If
iRnk = Application.InputBox(prompt:="Nhap Diem Cao thu:", Type:=1) 'Nhap tuy chon Diem Cao thu
If iRnk = 0 Then Exit Sub 'Khong nhap tuy chon thoat sub
With Sheet1
sArr = .Range("E2", .Range("N" & Rows.Count).End(xlUp)).Value 'Tao mang du lieu
End With
sRow = UBound(sArr) 'So dong du lieu
ReDim Arr(0 To 100) 'Mang "Lan Thi" voi thu tu dong la "Diem" tu 0 den 100
ReDim Res(1 To sRow, 1 To 5) 'Mang Ket Qua
With CreateObject("Scripting.Dictionary")
For i = 1 To sRow
If fDay <= sArr(i, 6) And eDay >= sArr(i, 6) Then
maSV = sArr(i, 1) 'Ten Sinh Vien
Diem = sArr(i, 10) 'Diem so cua sinh vien
If .Exists(maSV) = False Then 'Loc sinh vien duy nhat
k = k + 1
Res(k, 1) = k 'So thu tu sinh vien
Res(k, 2) = maSV 'Tính lai Ten Sinh Vien trong file thuc te
.Add maSV, Arr 'Add sinh vien vao Dic de loai trung, voi Item la mang Diem
End If
tmp = .Item(maSV) 'Mang "Thu tu dong cua sArr"
'Gan thu tu dong i vào dong "Diem". Chon 1 trong 2 lenh duoi
tmp(Diem) = i 'Lay lan thi cuoi
'If tmp(Diem) = Empty Then tmp(Diem) = i 'Lay lan thi dau
.Item(maSV) = tmp 'Gan tmp vào Item cua Dic
End If
Next i
If k Then 'Neu co danh sach sinh vien
For i = 1 To k
tmp = .Item(Res(i, 2)) 'Mang "Lan Thi" cua sinh vien thu i
q = 0 'Bien dem
For Diem = 100 To 0 Step -1
If tmp(Diem) <> Empty Then q = q + 1 ' Diem Cao thu q
If q = iRnk Then 'Neu Diem Cao thu thoa dieu kien
ik = tmp(Diem) ' thu tu dong cua sArr
Res(i, 3) = sArr(ik, 6) 'Ngay thi
Res(i, 4) = sArr(ik, 7) 'Gio thi
Res(i, 5) = Diem ' Diem Cao thu iRnk
Exit For 'Thoat vong lap: For Diem = 100 To 0 Step -1
End If
Next Diem
Next i
Sheet2.Range("A5").Resize(k, 5) = Res 'Gan ket qua
End If
End With
End SubỞ kết quả nếu em nhập điểm có phẩy nó đang tự động làm tròn, ví dụ e nhập 88,4 nó làm tròn thành 88, nhập 88,6 nó làm tròn thành 89, em muốn giữ nguyên như mình nhập vào thì làm sao ạ
Bạn thử code này nhé.
Sub laydiem()
Const so As Integer = 1
Dim arr, kq, a As Long, olit As Object, ngaydau As Long, ngaycuoi As Long, lr As Long, dk As String, diem As Double
Dim i As Long, T, k As Integer, dic As Object, b As Long
Set olit = CreateObject("System.Collections.SortedList")
Set dic = CreateObject("scripting.dictionary")
With Sheets("sheet2")
ngaydau = .Range("D1").Value
ngaycuoi = .Range("d2").Value
.Range("A5:E500").ClearContents
End With
With Sheets("sheet1")
lr = .Range("E" & Rows.Count).End(xlUp).Row
If lr < 2 Then Exit Sub
arr = .Range("E2:N" & lr).Value
ReDim kq(1 To UBound(arr), 1 To 5)
For i = 1 To UBound(arr)
If ngaydau <= CLng(arr(i, 6)) And ngaycuoi >= CLng(arr(i, 6)) Then
diem = arr(i, 10)
If Not olit.contains(diem) Then
olit.Add diem, i
Else
olit.Item(diem) = olit.Item(diem) & "#" & i
End If
End If
Next i
If olit.Count = 0 Then Exit Sub
For k = olit.Count - 1 To 0 Step -1
For Each T In Split(olit.getbyindex(k), "#")
dk = arr(T, 1)
If Not dic.exists(dk) Then
dic.Add dk, Array(1, arr(T, 10))
End If
b = dic.Item(dk)(0)
diem = dic.Item(dk)(1)
If diem > arr(T, 10) Then
b = b + 1
End If
dic.Item(dk) = Array(b, arr(T, 10))
If b = so Then
a = a + 1
kq(a, 1) = a
kq(a, 2) = arr(T, 1)
kq(a, 3) = arr(T, 6)
kq(a, 4) = arr(T, 7)
kq(a, 5) = arr(T, 10)
End If
Next T
Next k
End With
With Sheets("sheet2")
If a Then .Range("A5:E5").Resize(a).Value = kq
End With
End Sub
