Nhờ giúp đỡ code lọc theo nhiều điều kiện. (2 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
P

pinklove

Thành viên thường trực
Tham gia
21/1/08
Bài viết
336
Được thích
42
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)
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
pinklove đã viết:
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)
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
snow25 đã viết:
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
Nhấp chuột vào đây để mở rộng...
Đú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é.
 
Upvote 0
pinklove đã viết:
Đú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é.
Nhấp chuột vào đây để mở rộng...
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.
 
Upvote 0
snow25 đã viết:
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.
Nhấp chuột vào đây để mở rộng...
Bắt buộc phải để vậy ạ
Bài đã được tự động gộp:

snow25 đã viết:
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
Nhấp chuột vào đây để mở rộng...
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.
 
Lần chỉnh sửa cuối:
Upvote 0
pinklove đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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é.:D.
 
Upvote 0
thuyyeu99 đã viết:
Mình b i bi sắc bí
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
pinklove đã viết:
Đú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é.
Nhấp chuột vào đây để mở rộng...
Đ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
 
Upvote 0
CHAOQUAY đã viết:
Đ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
Nhấp chuột vào đây để mở rộng...
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.
Bài đã được tự động gộp:

snow25 đã viết:
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
Nhấp chuột vào đây để mở rộng...
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 ạ??
 
Upvote 0
pinklove đã viết:
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.
Nhấp chuột vào đây để mở rộng...
Bạn xem chú thích bên dưới
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")
    '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
 
Upvote 0
pinklove đã viết:
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)
Nhấp chuột vào đây để mở rộ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
 
Upvote 0
HieuCD đã viết:
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
Nhấp chuột vào đây để mở rộng...
Thầy xử lý Array ra tay rồi
 
Upvote 0
HieuCD đã viết:
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
Nhấp chuột vào đây để mở rộng...
Cảm ơn bác ạ, code rất hay ạ. Bác cho em xin cái giải thích code được không ạ.
 
Upvote 0
pinklove đã viết:
Cảm ơn bác ạ, code rất hay ạ. Bác cho em xin cái giải thích code được không ạ.
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
HieuCD đã viết:
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
Nhấp chuột vào đây để mở rộng...
Em cảm ơn ạ
 
Upvote 0
HieuCD đã viết:
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
Nhấp chuột vào đây để mở rộng...
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 ạ?
Dữ liệu này đang là 1 lớp, bác code giúp em nếu là hàng chục lớp với hàng ngàn học sinh ạ.
 

File đính kèm

Upvote 0
Dùng AdvancedFilter thì Trình Văn Vịnh lớn 1 hay lớn 2 đều 86.
 
Upvote 0
buiquangthuan đã viết:
Thấy cấu truc lại khác với file ban đầu.
Nhấp chuột vào đây để mở rộng...
Đú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.
 
Upvote 0
pinklove đã viết:
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 ạ?
Dữ liệu này đang là 1 lớp, bác code giúp em nếu là hàng chục lớp với hàng ngàn học sinh ạ.
Nhấp chuột vào đây để mở rộng...
Làm sao phân biệt được SV khác nhau nhưng trùng tên?
 
Upvote 0
HieuCD đã viết:
Dữ liệu chỉ 1 môn hay nhiều môn? Nếu nhiều môn thì sao?
Nhấp chuột vào đây để mở rộng...
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 ạ.
 
Upvote 0
pinklove đã viết:
Có thể bỏ cái vụ trùng đi cũng đc ạ, nếu cao nhất thì chỉ lấy 1 thôi ạ.
Nhấp chuột vào đây để mở rộng...
pinklove đã viết:
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 ạ.
Nhấp chuột vào đây để mở rộng...
Xem code
Mã: 
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
 

File đính kèm

Upvote 0
HieuCD đã viết:
Xem code
Mã: 
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
Nhấp chuột vào đây để mở rộng...
Bài này nếu mình sắp xếp theo điểm rồi lấy vị trí có được không anh nhỉ.
 
Upvote 0
HieuCD đã viết:
Xem code
Mã: 
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
Nhấp chuột vào đây để mở rộng...
Ở 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 ạ
 
Upvote 0
pinklove đã viết:
Ở 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 ạ
Nhấp chuột vào đây để mở rộng...
Bạn thử code này nhé.
Mã: 
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
 
Upvote 0
snow25 đã viết:
Bạn thử code này nhé.
Mã: 
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
Nhấp chuột vào đây để mở rộng...
1575962850620.png
Báo lỗi bạn ạ
 
Upvote 0
snow25 đã viết:
Bạn thử code này nhé.
Mã: 
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
Nhấp chuột vào đây để mở rộng...
Hay nhỉ :thumbs:
 
Upvote 0
Haha nhìn mấy code này nhớ lại thời sinh viên quá đi, giờ mình làm chuyên lập trình php mấy cái này không nhớ nhiều không giúp anh em được
 
Upvote 0
pinklove đã viết:
Ở 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 ạ
Nhấp chuột vào đây để mở rộng...
Chỉ chấp nhận 1 số lẽ
Chỉnh các dòng lệnh
ReDim Arr(0 To 1000)
Diem = sArr(i, 10) * 10
For Diem = 1000 To 0 Step -1
Res(i, 5) = Diem / 10
Mã: 
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 1000)                                                '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) * 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 = 1000 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 / 10                                       ' 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
 
Upvote 0
HieuCD đã viết:
Chỉ chấp nhận 1 số lẽ
Chỉnh các dòng lệnh
ReDim Arr(0 To 1000)
Diem = sArr(i, 10) * 10
For Diem = 1000 To 0 Step -1
Res(i, 5) = Diem / 10
Mã: 
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 1000)                                                '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) * 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 = 1000 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 / 10                                       ' 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
Nhấp chuột vào đây để mở rộng...
Với file là điểm này thì 1 số lẻ là ok ạ. Nhưng em theo cách hiểu của em thì với mỗi số lẻ phía sau thì e thêm 1 số 0. Em thử với file có 5 số lẻ thì thấy code chậm hơn nhiều.
 
Upvote 0
pinklove đã viết:
Với file là điểm này thì 1 số lẻ là ok ạ. Nhưng em theo cách hiểu của em thì với mỗi số lẻ phía sau thì e thêm 1 số 0. Em thử với file có 5 số lẻ thì thấy code chậm hơn nhiều.
Nhấp chuột vào đây để mở rộng...
Đúng thế mà.Nó chạy nhiều vòng lặp hơn thì chậm hơn là phải rồi.
 
Upvote 0
pinklove đã viết:
Với file là điểm này thì 1 số lẻ là ok ạ. Nhưng em theo cách hiểu của em thì với mỗi số lẻ phía sau thì e thêm 1 số 0. Em thử với file có 5 số lẻ thì thấy code chậm hơn nhiều.
Nhấp chuột vào đây để mở rộng...
Nếu số lẻ nhiều mảng điểm sẽ lớn chạy nhiều lần sẽ chậm, dùng SortList ổn hơn
 
Upvote 0
pinklove đã viết:
Tức là sắp xếp theo thứ tự rồi mới quét ấy ạ
Nhấp chuột vào đây để mở rộng...
Chạy code
Mã: 
Sub LargeNumeFilter()
  Dim sArr(), Res(), Arr(), bK As Boolean
  Dim sRow&, iRnk&, i&, k&, 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
    i = .Range("E" & Rows.Count).End(xlUp).Row 'Dong cuoi sheet1
    Arr = .Range("E2:N" & i).Value  'Tao mang du lieu Goc
    .Range("E2:N" & i).Sort .Range("E2"), 1, .Range("N2"), , 2, Header:=xlNo 'Sort du lieu
    sArr = .Range("E2:N" & i + 1).Value  'Tao mang du lieu da Sort
    .Range("E2:N" & i).Value = Arr 'Tra ve du lieu goc
  End With
  sRow = UBound(sArr)                                                'So dong du lieu
  ReDim Res(1 To sRow, 1 To 5)                                       'Mang Ket Qua
  For i = 1 To sRow - 1
    If fDay <= sArr(i, 6) And eDay >= sArr(i, 6) Then
      If maSV <> sArr(i, 1) Then                                                'Ten Sinh Vien
        maSV = sArr(i, 1)
        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
        Diem = sArr(i, 10) + 1                                           'Diem so cua sinh vien
        q = 0
        bK = True
      End If
      If bK = True Then
        If Diem > sArr(i, 10) Then
          Diem = sArr(i, 10)
          q = q + 1
          If q = iRnk Then                                           'Neu Diem Cao thu thoa dieu kien
            Res(k, 3) = sArr(i, 6) 'Ngay thi
            Res(k, 4) = sArr(i, 7) 'Gio thi
            Res(k, 5) = Diem                                        ' Diem Cao thu iRnk
            bK = False                                               'Thoat vong lap: For Diem = 100 To 0 Step -1
          End If
        End If                                               'Gan tmp vào Item cua Dic
      End If
    End If
  Next i
  If k Then                                                        'Neu co danh sach sinh vien
    Sheet2.Range("A5").Resize(k, 5) = Res                          'Gan ket qua
  End If

End Sub
 
Upvote 0
HieuCD đã viết:
Nếu số lẻ nhiều mảng điểm sẽ lớn chạy nhiều lần sẽ chậm, dùng SortList ổn hơn
Nhấp chuột vào đây để mở rộng...
pinklove đã viết:
Vậy với code này có cách nào tối ưu hơn ko ạ?
Nhấp chuột vào đây để mở rộng...
Bạn thử.
Mã: 
Sub laydiem()
    Const so As Integer = 5
    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, s1 As String, s2 As String, mang1, mang2, j As Long, m As Long
    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
               dk = arr(i, 1)
               If Not dic.exists(dk) Then
                  dic.Add dk, Array("#" & arr(i, 10), "#" & i)
               Else
                  s1 = dic.Item(dk)(0) & "#" & arr(i, 10)
                  s2 = dic.Item(dk)(1) & "#" & i
                  dic.Item(dk) = Array(s1, s2)
               End If
           End If
       Next i
       For Each T In dic.keys
           b = 1
           s1 = dic.Item(T)(0)
           s2 = dic.Item(T)(1)
           mang1 = Split(s1, "#")
           mang2 = Split(s2, "#")
           k = UBound(mang1)
           For i = 1 To k
               For j = k - 1 To i Step -1
                   If mang1(j) < mang1(j + 1) Then
                      diem = mang1(j + 1)
                      mang1(j + 1) = mang1(j)
                      mang1(j) = diem
                   End If
               Next j
               If i > 1 Then
                  If mang1(i) < mang1(i - 1) Then b = b + 1
               End If
               If b = so Then
                  diem = mang1(i)
                  mang1 = Split(s1, "#")
                  For m = 1 To k
                      If mang1(m) = diem Then
                         a = a + 1
                         kq(a, 1) = a
                         kq(a, 2) = arr(mang2(m), 1)
                         kq(a, 3) = arr(mang2(m), 6)
                         kq(a, 4) = arr(mang2(m), 7)
                         kq(a, 5) = arr(mang2(m), 10)
                      End If
                 Next m
                 Exit For
             End If
           Next i
       Next
  End With
  With Sheets("sheet2")
       If a Then .Range("A5:E5").Resize(a).Value = kq
  End With
End Sub
 
Upvote 0
HieuCD đã viết:
Chạy code
Mã: 
Sub LargeNumeFilter()
  Dim sArr(), Res(), Arr(), bK As Boolean
  Dim sRow&, iRnk&, i&, k&, 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
    i = .Range("E" & Rows.Count).End(xlUp).Row 'Dong cuoi sheet1
    Arr = .Range("E2:N" & i).Value  'Tao mang du lieu Goc
    .Range("E2:N" & i).Sort .Range("E2"), 1, .Range("N2"), , 2, Header:=xlNo 'Sort du lieu
    sArr = .Range("E2:N" & i + 1).Value  'Tao mang du lieu da Sort
    .Range("E2:N" & i).Value = Arr 'Tra ve du lieu goc
  End With
  sRow = UBound(sArr)                                                'So dong du lieu
  ReDim Res(1 To sRow, 1 To 5)                                       'Mang Ket Qua
  For i = 1 To sRow - 1
    If fDay <= sArr(i, 6) And eDay >= sArr(i, 6) Then
      If maSV <> sArr(i, 1) Then                                                'Ten Sinh Vien
        maSV = sArr(i, 1)
        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
        Diem = sArr(i, 10) + 1                                           'Diem so cua sinh vien
        q = 0
        bK = True
      End If
      If bK = True Then
        If Diem > sArr(i, 10) Then
          Diem = sArr(i, 10)
          q = q + 1
          If q = iRnk Then                                           'Neu Diem Cao thu thoa dieu kien
            Res(k, 3) = sArr(i, 6) 'Ngay thi
            Res(k, 4) = sArr(i, 7) 'Gio thi
            Res(k, 5) = Diem                                        ' Diem Cao thu iRnk
            bK = False                                               'Thoat vong lap: For Diem = 100 To 0 Step -1
          End If
        End If                                               'Gan tmp vào Item cua Dic
      End If
    End If
  Next i
  If k Then                                                        'Neu co danh sach sinh vien
    Sheet2.Range("A5").Resize(k, 5) = Res                          'Gan ket qua
  End If

End Sub
Nhấp chuột vào đây để mở rộng...
Chuẩn rồi ạ, qua những code anh đã giúp em ngẫm ra được rất nhiều điều, cảm ơn anh ạ.
snow25 đã viết:
Bạn thử.
Mã: 
Sub laydiem()
    Const so As Integer = 5
    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, s1 As String, s2 As String, mang1, mang2, j As Long, m As Long
    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
               dk = arr(i, 1)
               If Not dic.exists(dk) Then
                  dic.Add dk, Array("#" & arr(i, 10), "#" & i)
               Else
                  s1 = dic.Item(dk)(0) & "#" & arr(i, 10)
                  s2 = dic.Item(dk)(1) & "#" & i
                  dic.Item(dk) = Array(s1, s2)
               End If
           End If
       Next i
       For Each T In dic.keys
           b = 1
           s1 = dic.Item(T)(0)
           s2 = dic.Item(T)(1)
           mang1 = Split(s1, "#")
           mang2 = Split(s2, "#")
           k = UBound(mang1)
           For i = 1 To k
               For j = k - 1 To i Step -1
                   If mang1(j) < mang1(j + 1) Then
                      diem = mang1(j + 1)
                      mang1(j + 1) = mang1(j)
                      mang1(j) = diem
                   End If
               Next j
               If i > 1 Then
                  If mang1(i) < mang1(i - 1) Then b = b + 1
               End If
               If b = so Then
                  diem = mang1(i)
                  mang1 = Split(s1, "#")
                  For m = 1 To k
                      If mang1(m) = diem Then
                         a = a + 1
                         kq(a, 1) = a
                         kq(a, 2) = arr(mang2(m), 1)
                         kq(a, 3) = arr(mang2(m), 6)
                         kq(a, 4) = arr(mang2(m), 7)
                         kq(a, 5) = arr(mang2(m), 10)
                      End If
                 Next m
                 Exit For
             End If
           Next i
       Next
  End With
  With Sheets("sheet2")
       If a Then .Range("A5:E5").Resize(a).Value = kq
  End With
End Sub
Nhấp chuột vào đây để mở rộng...
Mình chạy code này nó ko hoạt động, đứng im luôn bạn ạ
 
Upvote 0
pinklove đã viết:
Chuẩn rồi ạ, qua những code anh đã giúp em ngẫm ra được rất nhiều điều, cảm ơn anh ạ.

Mình chạy code này nó ko hoạt động, đứng im luôn bạn ạ
Nhấp chuột vào đây để mở rộng...
Bạn chỉnh chỗ này.
Const so As Integer = 5
Sửa thành số thứ tự bạn cần lấy.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

D
XIN PHẦN MỀM XẾP TKB TIỂU HỌC BẰNG EXCEL (1 người xem)
Trả lời
0
Đọc
18
danhpheo
D
H
Tự động cập nhật dữ liệu từ 2 file word
Trả lời
1
Đọc
50
LOGANWover
L
N
Nhờ giúp Drop down list theo tỉnh xã mới.
Trả lời
7
Đọc
226
ongke0711
ongke0711
E
VBA copy ô trong excel khi đang lọc filter
Trả lời
8
Đọc
107
eagle12
E
R
Các bác có kinh nghiệm excel cho em xin công thức đánh số thứ tự theo ngày tháng này vợi ạ.
Trả lời
4
Đọc
95
HieuCD
H
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (3 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
3 4 5
Trả lời
436
Đọc
57K
hangiang
H
N
Không sử dụng được phím tắt Ctrl + Shift + mũi tên xuống (1 người xem)
Trả lời
1
Đọc
3K
aFdangthacmac
A
L
  • Question Question
Gõ và chọn tên trong ComboBox hiển thị giá trị trong textbox
    • Cười
Trả lời
8
Đọc
365
ongke0711
ongke0711
befaint
[ Python và ứng dụng ] Công cụ trích xuất hàng loạt hóa đơn điện tử XML vào bảng Excel (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
56
Đọc
9K
Hoale85
H
Nam168
Không mở được file excel
Trả lời
2
Đọc
67
Nam168
Nam168
V
Quản lý xuất nhập vật tư trong kho
Trả lời
14
Đọc
531
LOGANWover
L
phuongnam366377
Sử dụng COM DLL **không cần đăng ký** với Delphi 12 / C++ Builder
    • Thích
Trả lời
0
Đọc
81
phuongnam366377
phuongnam366377
N
Định mức nguyên vật liệu (1 người xem)
Trả lời
49
Đọc
5K
ntan50
N
H
  • Question Question
Dò tìm giá trị từ bảng khác theo cột
Trả lời
6
Đọc
287
Chả_biết_gì
C
2
  • Question Question
Hỏi cách in phiếu điều tra PCGD-XMC từ file dữ liệu mẫu xuất ra từ hệ thống PCGD-XMC của Bộ GD
    • Thích
Trả lời
26
Đọc
1K
haitien123
H
ongke0711
Truy cập trang GPE chậm (1 người xem)
    • Thích
Trả lời
3
Đọc
195
Hai Lúa Miền Tây
Hai Lúa Miền Tây
V
Gộp File Từng File Excel vào 1 File
Trả lời
16
Đọc
492
ptm0412
ptm0412
Gà Con yêu VBA
Mở Pass file excel phiên bản .xlsx , xlsm, xlsb
Trả lời
10
Đọc
800
Zizi One
Zizi One
I
Phân bổ số lượng xuất kho trong kỳ theo từng mã nguyên vật liệu
Trả lời
6
Đọc
211
IrisQ
I
L
Các bạn giúp mình hoàn thiện công thức hàm sumif nhé
Trả lời
5
Đọc
174
lequang_qn
L
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom