Bạn thử nhé.Mình có file Điểm như đính kèm, Mình muốn lọc điểm lớn nhất của từng người ở sheet 1, lấy ra kết quả sang sheet 2. Nhờ các bạn giúp đỡ.
Nếu có thể thì giúp mình luôn code lọc điểm cao thứ 2 và thứ 3 ( Cái này có thể tùy chọn cần lấy kết quả thứ mấy)
Sub khongxembongda()
Dim arr, kq, i As Long, a As Long, lr As Long, dic As Object, dk As String, b As Long
Set dic = CreateObject("scripting.dictionary")
With Sheets("sheet1")
lr = .Range("B" & Rows.Count).End(xlUp).Row
arr = .Range("B2:E" & lr).Value
ReDim kq(1 To UBound(arr), 1 To 5)
End With
For i = 1 To UBound(arr)
dk = UCase(arr(i, 1))
If Not dic.exists(dk) Then
a = a + 1
dic.Add dk, a
kq(a, 1) = a
kq(a, 2) = arr(i, 1)
kq(a, 3) = arr(i, 2)
kq(a, 4) = arr(i, 3)
kq(a, 5) = arr(i, 4)
Else
b = dic.Item(dk)
If kq(b, 4) < arr(i, 3) Then
kq(b, 3) = arr(i, 2)
kq(b, 4) = arr(i, 3)
kq(b, 5) = arr(i, 4)
End If
End If
Next i
With Sheets("sheet2")
lr = .Range("B" & Rows.Count).End(xlUp).Row
If lr > 2 Then .Range("A2:E" & lr).ClearContents
If a Then .Range("A2:E2").Resize(a).Value = kq
End With
End Sub
Đúng rồi bạn ạ. Nhưng mình quên mất 1 cái, đó là như trong file mẫu thì nếu 1 người mà có nhiều kỳ thi có điểm cao nhất bằng nhau thì liệt kê tất cả luôn ạ.Bạn thử nhé.
Mã:Sub khongxembongda() Dim arr, kq, i As Long, a As Long, lr As Long, dic As Object, dk As String, b As Long Set dic = CreateObject("scripting.dictionary") With Sheets("sheet1") lr = .Range("B" & Rows.Count).End(xlUp).Row arr = .Range("B2:E" & lr).Value ReDim kq(1 To UBound(arr), 1 To 5) End With For i = 1 To UBound(arr) dk = UCase(arr(i, 1)) If Not dic.exists(dk) Then a = a + 1 dic.Add dk, a kq(a, 1) = a kq(a, 2) = arr(i, 1) kq(a, 3) = arr(i, 2) kq(a, 4) = arr(i, 3) kq(a, 5) = arr(i, 4) Else b = dic.Item(dk) If kq(b, 4) < arr(i, 3) Then kq(b, 3) = arr(i, 2) kq(b, 4) = arr(i, 3) kq(b, 5) = arr(i, 4) End If End If Next i With Sheets("sheet2") lr = .Range("B" & Rows.Count).End(xlUp).Row If lr > 2 Then .Range("A2:E" & lr).ClearContents If a Then .Range("A2:E2").Resize(a).Value = kq End With End Sub
File điểm của bạn có thể sắp xếp theo thứ tự điểm từ trên xuống dưới được không.Hay bắt buộc phải để như vậy.Đúng rồi bạn ạ. Nhưng mình quên mất 1 cái, đó là như trong file mẫu thì nếu 1 người mà có nhiều kỳ thi có điểm cao nhất bằng nhau thì liệt kê tất cả luôn ạ.
Ngoài ra có thêm cái điểm cao thứ 2 và thứ 3 bạn giúp mình luôn nhé.
Bắt buộc phải để vậy ạFile điểm của bạn có thể sắp xếp theo thứ tự điểm từ trên xuống dưới được không.Hay bắt buộc phải để như vậy.
Cái đoạn này có thể viết gọn hơn lại được ko bạn nhỉ, vì lỡ dữ liệu có hàng chục cột chẳng hạn viết thế này sẽ dài ngoằng. Cái này mình muốn hiểu thêm nên hỏi thôi.kq(a, 1) = a
kq(a, 2) = arr(i, 1)
kq(a, 3) = arr(i, 2)
kq(a, 4) = arr(i, 3)
kq(a, 5) = arr(i, 4)
Else
b = dic.Item(dk)
If kq(b, 4) < arr(i, 3) Then
kq(b, 3) = arr(i, 2)
kq(b, 4) = arr(i, 3)
kq(b, 5) = arr(i, 4)
End If
Dược Bạn thay thế bằng vòng lặp FOR Next.Nếu dữ liệu như vậy viết code dài lắm.Mà mình dạo này bận nên không viết được.Bạn đợi bạn khác giúp nhé..Bắt buộc phải để vậy ạ
Bài đã được tự động gộp:
Cái đoạn này có thể viết gọn hơn lại được ko bạn nhỉ, vì lỡ dữ liệu có hàng chục cột chẳng hạn viết thế này sẽ dài ngoằng. Cái này mình muốn hiểu thêm nên hỏi thôi.
Vâng, cảm ơn bạn đã giúp đỡ.Dược Bạn thay thế bằng vòng lặp FOR Next.Nếu dữ liệu như vậy viết code dài lắm.Mà mình dạo này bận nên không viết được.Bạn đợi bạn khác giúp nhé..
Cái vòng lặp này mình làm được rồi ạ. Còn lại các yêu cầu sau của bài toán thôi.Mã:kq(a, 1) = a For icol =1 to TongCols kq(a, icol+1) = arr(i, icol) Next
Điểm cao thứ 1 hoặc 2 hoặc 3... : Thay đổi giá trị của kĐúng rồi bạn ạ. Nhưng mình quên mất 1 cái, đó là như trong file mẫu thì nếu 1 người mà có nhiều kỳ thi có điểm cao nhất bằng nhau thì liệt kê tất cả luôn ạ.
Ngoài ra có thêm cái điểm cao thứ 2 và thứ 3 bạn giúp mình luôn nhé.
Sub locdiem()
Dim DL
Dim Diem
Dim Mang
Dim Kq
Dim rws
Dim i, j, k, x, z, t
DL = Sheet1.Range("A1").CurrentRegion
rws = UBound(DL)
ReDim Diem(100)
With CreateObject("Scripting.Dictionary")
For i = 2 To rws
If .Exists(DL(i, 2)) = False Then
Mang = Diem
Mang(DL(i, 4)) = DL(i, 3)
.Item(DL(i, 2)) = Mang
Else
Mang = .Item(DL(i, 2))
Mang(DL(i, 4)) = Mang(DL(i, 4)) & IIf(Mang(DL(i, 4)), " ", "") & DL(i, 3)
.Item(DL(i, 2)) = Mang
End If
Next i
ReDim Kq(1 To rws, 1 To 5)
k = 1
x = 0
For i = 0 To .Count - 1
Mang = .Items()(i)
z = 0
For j = 100 To 0 Step -1
If Mang(j) <> "" Then z = z + 1
If z = k Then
t = Mang(j)
Exit For
End If
Next j
If InStr(t, " ") = 0 Then
x = x + 1
Kq(x, 1) = x
Kq(x, 2) = .Keys()(i)
Kq(x, 3) = t
Kq(x, 4) = j
Else
For Each z In Split(t)
x = x + 1
Kq(x, 1) = x
Kq(x, 2) = .Keys()(i)
Kq(x, 3) = z
Kq(x, 4) = j
Next z
End If
Next i
End With
Sheet2.Range("A2").Resize(x, UBound(Kq, 2)) = Kq
End Sub
Cảm ơn bạn, đúng như ý mình rồi đó ạ. Nhưng code của bạn "snow25" mình đọc có thể hiểu được, chứ code của bạn mình ngồi đến giờ này ngâm vẫn chưa hiểu hết. Bạn có thể chú thích code giúp mình không? Mình cũng đang học nên rất muốn hiểu được, sau đỡ hỏi.Điểm cao thứ 1 hoặc 2 hoặc 3... : Thay đổi giá trị của k
Mã:Sub locdiem() Dim DL Dim Diem Dim Mang Dim Kq Dim rws Dim i, j, k, x, z, t DL = Sheet1.Range("A1").CurrentRegion rws = UBound(DL) ReDim Diem(100) With CreateObject("Scripting.Dictionary") For i = 2 To rws If .Exists(DL(i, 2)) = False Then Mang = Diem Mang(DL(i, 4)) = DL(i, 3) .Item(DL(i, 2)) = Mang Else Mang = .Item(DL(i, 2)) Mang(DL(i, 4)) = Mang(DL(i, 4)) & IIf(Mang(DL(i, 4)), " ", "") & DL(i, 3) .Item(DL(i, 2)) = Mang End If Next i ReDim Kq(1 To rws, 1 To 5) k = 1 x = 0 For i = 0 To .Count - 1 Mang = .Items()(i) z = 0 For j = 100 To 0 Step -1 If Mang(j) <> "" Then z = z + 1 If z = k Then t = Mang(j) Exit For End If Next j If InStr(t, " ") = 0 Then x = x + 1 Kq(x, 1) = x Kq(x, 2) = .Keys()(i) Kq(x, 3) = t Kq(x, 4) = j Else For Each z In Split(t) x = x + 1 Kq(x, 1) = x Kq(x, 2) = .Keys()(i) Kq(x, 3) = z Kq(x, 4) = j Next z End If Next i End With Sheet2.Range("A2").Resize(x, UBound(Kq, 2)) = Kq End Sub
Với code của bạn thì để lấy giá trị bằng nhau thứ 2 mình phải sửa thế nào ạ??Bạn làm theo thuật toán là sắp xếp theo thứ tự từ trên xuống dưới rồi duyệt dữ liệu từ trên xuống dưới.lấy các giá trị bằng nhau đầu tiên là được đáp án thứ nhất.lấy giá trị thứ 2 là được đáp án thứ 2.hihi
Bạn xem chú thích bên dướiCảm ơn bạn, đúng như ý mình rồi đó ạ. Nhưng code của bạn "snow25" mình đọc có thể hiểu được, chứ code của bạn mình ngồi đến giờ này ngâm vẫn chưa hiểu hết. Bạn có thể chú thích code giúp mình không? Mình cũng đang học nên rất muốn hiểu được, sau đỡ hỏi.
Sub locdiem()
Dim DL
Dim Diem
Dim Mang
Dim Kq
Dim rws
Dim i, j, k, x, z, t
DL = Sheet1.Range("A1").CurrentRegion
rws = UBound(DL)
ReDim Diem(100)
With CreateObject("Scripting.Dictionary")
'Nap danh sach vao Dic.
'Key=Ten; Item=Mang 101 phan tu ( 0-100 )
'Lay diem so lam vitri trong Mang, dien lan thi vao vi tri do
For i = 2 To rws
If .Exists(DL(i, 2)) = False Then
Mang = Diem '<--Mang 101 phan tu ( 0-100 )
Mang(DL(i, 4)) = DL(i, 3) '<--'Lay diem so lam vitri trong Mang, dien lan thi vao vitri do
.Item(DL(i, 2)) = Mang
Else
Mang = .Item(DL(i, 2))
Mang(DL(i, 4)) = Mang(DL(i, 4)) & IIf(Mang(DL(i, 4)), " ", "") & DL(i, 3)
.Item(DL(i, 2)) = Mang
End If
Next i
'KT Nap danh sach vao Dic.
'Xuat ket qua
ReDim Kq(1 To rws, 1 To 5)
k = 1
x = 0
For i = 0 To .Count - 1
Mang = .Items()(i) 'Keys()(i)=Ten; .Items()(i)=Danh sach lan thi tuong ung
'Dem nguoc tu 100-0, tim diem thi cao thu k, lay ra so lan thi tai diem do
z = 0
For j = 100 To 0 Step -1
If Mang(j) <> "" Then z = z + 1
If z = k Then
t = Mang(j)
Exit For
End If
Next j
'KT Dem nguoc tu 100-0, tim diem thi cao thu k, lay ra so lan thi tai diem do
'Kiem tra xem thi 1 hay nhieu lan, dien diem so, lan thi vao Kq
If InStr(t, " ") = 0 Then '<--Thi 1 lan
x = x + 1
Kq(x, 1) = x
Kq(x, 2) = .Keys()(i)
Kq(x, 3) = t
Kq(x, 4) = j
Else
For Each z In Split(t) '<--Thi >1 lan
x = x + 1
Kq(x, 1) = x
Kq(x, 2) = .Keys()(i)
Kq(x, 3) = z
Kq(x, 4) = j
Next z
End If
'KT Kiem tra xem thi 1 hay nhieu lan, dien diem so, lan thi vao Kq
Next i
'KT Xuat ket qua
End With
Sheet2.Range("A2").Resize(x, UBound(Kq, 2)) = Kq
End Sub
Thử codeMình có file Điểm như đính kèm, Mình muốn lọc điểm lớn nhất của từng người ở sheet 1, lấy ra kết quả sang sheet 2. Nhờ các bạn giúp đỡ.
Nếu có thể thì giúp mình luôn code lọc điểm cao thứ 2 và thứ 3 ( Cái này có thể tùy chọn cần lấy kết quả thứ mấy)
Sub LargeNumeFilter()
Dim sArr(), Res(), Arr(), tmp, SV$, Diem&
Dim sRow&, iRnk&, i&, j&, k&, q&
Sheet2.Range("A2:D500").ClearContents
iRnk = Application.InputBox(prompt:="Nhap Diem Cao thu:", Type:=1)
If iRnk = 0 Then Exit Sub
With Sheet1
sArr = .Range("B2", .Range("D" & Rows.Count).End(xlUp)).Value
End With
sRow = UBound(sArr)
ReDim Arr(0 To 100)
ReDim Res(1 To sRow, 1 To 4)
With CreateObject("Scripting.Dictionary")
For i = 1 To sRow
SV = sArr(i, 1): Diem = sArr(i, 3)
If .Exists(SV) = False Then
k = k + 1: Res(k, 1) = k
Res(k, 2) = SV: .Add SV, Arr
End If
tmp = .Item(SV)
tmp(Diem) = tmp(Diem) & ", " & sArr(i, 2)
.Item(SV) = tmp
Next i
If k Then
For i = 1 To k
tmp = .Item(Res(i, 2))
q = 0
For Diem = 100 To 0 Step -1
If tmp(Diem) <> Empty Then q = q + 1
If q = iRnk Then
Res(i, 3) = Mid(tmp(Diem), 3, 50)
Res(i, 4) = Diem
Exit For
End If
Next Diem
Next i
Sheet2.Range("A2").Resize(k, 4) = Res
End If
End With
End Sub
Thầy xử lý Array ra tay rồiThử code
Mã:Sub LargeNumeFilter() Dim sArr(), Res(), Arr(), tmp, SV$, Diem& Dim sRow&, iRnk&, i&, j&, k&, q& Sheet2.Range("A2:D500").ClearContents iRnk = Application.InputBox(prompt:="Nhap Diem Cao thu:", Type:=1) If iRnk = 0 Then Exit Sub With Sheet1 sArr = .Range("B2", .Range("D" & Rows.Count).End(xlUp)).Value End With sRow = UBound(sArr) ReDim Arr(0 To 100) ReDim Res(1 To sRow, 1 To 4) With CreateObject("Scripting.Dictionary") For i = 1 To sRow SV = sArr(i, 1): Diem = sArr(i, 3) If .Exists(SV) = False Then k = k + 1: Res(k, 1) = k Res(k, 2) = SV: .Add SV, Arr End If tmp = .Item(SV) tmp(Diem) = tmp(Diem) & ", " & sArr(i, 2) .Item(SV) = tmp Next i If k Then For i = 1 To k tmp = .Item(Res(i, 2)) q = 0 For Diem = 100 To 0 Step -1 If tmp(Diem) <> Empty Then q = q + 1 If q = iRnk Then Res(i, 3) = Mid(tmp(Diem), 3, 50) Res(i, 4) = Diem Exit For End If Next Diem Next i Sheet2.Range("A2").Resize(k, 4) = Res End If End With End Sub
Cảm ơn bác ạ, code rất hay ạ. Bác cho em xin cái giải thích code được không ạ.Thử code
Mã:Sub LargeNumeFilter() Dim sArr(), Res(), Arr(), tmp, SV$, Diem& Dim sRow&, iRnk&, i&, j&, k&, q& Sheet2.Range("A2:D500").ClearContents iRnk = Application.InputBox(prompt:="Nhap Diem Cao thu:", Type:=1) If iRnk = 0 Then Exit Sub With Sheet1 sArr = .Range("B2", .Range("D" & Rows.Count).End(xlUp)).Value End With sRow = UBound(sArr) ReDim Arr(0 To 100) ReDim Res(1 To sRow, 1 To 4) With CreateObject("Scripting.Dictionary") For i = 1 To sRow SV = sArr(i, 1): Diem = sArr(i, 3) If .Exists(SV) = False Then k = k + 1: Res(k, 1) = k Res(k, 2) = SV: .Add SV, Arr End If tmp = .Item(SV) tmp(Diem) = tmp(Diem) & ", " & sArr(i, 2) .Item(SV) = tmp Next i If k Then For i = 1 To k tmp = .Item(Res(i, 2)) q = 0 For Diem = 100 To 0 Step -1 If tmp(Diem) <> Empty Then q = q + 1 If q = iRnk Then Res(i, 3) = Mid(tmp(Diem), 3, 50) Res(i, 4) = Diem Exit For End If Next Diem Next i Sheet2.Range("A2").Resize(k, 4) = Res End If End With End Sub
Cảm ơn bác ạ, code rất hay ạ. Bác cho em xin cái giải thích code được không ạ.
Sub LargeNumeFilter()
Dim sArr(), Res(), Arr(), tmp, SV$, Diem&
Dim sRow&, iRnk&, i&, j&, k&, q&
Sheet2.Range("A2:D500").ClearContents 'Xoa ket qua
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("B2", .Range("D" & 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 4) 'Mang Ket Qua
With CreateObject("Scripting.Dictionary")
For i = 1 To sRow
SV = sArr(i, 1) 'Ten Sinh Vien
Diem = sArr(i, 3) 'Diem so cua sinh vien
If .Exists(SV) = False Then 'Loc sinh vien duy nhat
k = k + 1
Res(k, 1) = k 'So thu tu sinh vien
Res(k, 2) = SV 'Ten Sinh Vien
.Add SV, Arr 'Add sinh vien vao Dic de loai trung, voi Item la mang Diem
End If
tmp = .Item(SV) 'Mang "Lan Thi"
tmp(Diem) = tmp(Diem) & ", " & sArr(i, 2) 'Gan "Lan Thi" vào dong "Diem"
.Item(SV) = tmp 'Gan tmp vào Item cua Dic
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
Res(i, 3) = Mid(tmp(Diem), 3, 50) 'Lan thi, loai bo dau ", " o dau ket qua
Res(i, 4) = 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("A2").Resize(k, 4) = Res 'Gan ket qua
End If
End With
End Sub
Em cảm ơn ạMã:Sub LargeNumeFilter() Dim sArr(), Res(), Arr(), tmp, SV$, Diem& Dim sRow&, iRnk&, i&, j&, k&, q& Sheet2.Range("A2:D500").ClearContents 'Xoa ket qua 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("B2", .Range("D" & 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 4) 'Mang Ket Qua With CreateObject("Scripting.Dictionary") For i = 1 To sRow SV = sArr(i, 1) 'Ten Sinh Vien Diem = sArr(i, 3) 'Diem so cua sinh vien If .Exists(SV) = False Then 'Loc sinh vien duy nhat k = k + 1 Res(k, 1) = k 'So thu tu sinh vien Res(k, 2) = SV 'Ten Sinh Vien .Add SV, Arr 'Add sinh vien vao Dic de loai trung, voi Item la mang Diem End If tmp = .Item(SV) 'Mang "Lan Thi" tmp(Diem) = tmp(Diem) & ", " & sArr(i, 2) 'Gan "Lan Thi" vào dong "Diem" .Item(SV) = tmp 'Gan tmp vào Item cua Dic 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 Res(i, 3) = Mid(tmp(Diem), 3, 50) 'Lan thi, loai bo dau ", " o dau ket qua Res(i, 4) = 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("A2").Resize(k, 4) = Res 'Gan ket qua End If End With End Sub
Hi bác, em ngồi mò mấy ngày mà vẫn ko hiểu hết được code của bác. Em thử sửa thành cấu trúc file data kiểu khác rồi sửa code để được theo mong muốn nhưng không được. Em up file mới lên đây, nhờ bác code lại giúp theo cái này để em so sánh sự thay đổi giữa 2 code em rút ra được điều mình cần ạ?Mã:Sub LargeNumeFilter() Dim sArr(), Res(), Arr(), tmp, SV$, Diem& Dim sRow&, iRnk&, i&, j&, k&, q& Sheet2.Range("A2:D500").ClearContents 'Xoa ket qua 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("B2", .Range("D" & 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 4) 'Mang Ket Qua With CreateObject("Scripting.Dictionary") For i = 1 To sRow SV = sArr(i, 1) 'Ten Sinh Vien Diem = sArr(i, 3) 'Diem so cua sinh vien If .Exists(SV) = False Then 'Loc sinh vien duy nhat k = k + 1 Res(k, 1) = k 'So thu tu sinh vien Res(k, 2) = SV 'Ten Sinh Vien .Add SV, Arr 'Add sinh vien vao Dic de loai trung, voi Item la mang Diem End If tmp = .Item(SV) 'Mang "Lan Thi" tmp(Diem) = tmp(Diem) & ", " & sArr(i, 2) 'Gan "Lan Thi" vào dong "Diem" .Item(SV) = tmp 'Gan tmp vào Item cua Dic 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 Res(i, 3) = Mid(tmp(Diem), 3, 50) 'Lan thi, loai bo dau ", " o dau ket qua Res(i, 4) = 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("A2").Resize(k, 4) = Res 'Gan ket qua End If End With End Sub
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2