Lấy điểm từ nhiều môn vào 1 danh sách chung. Nhờ các bác giúp đỡ!

Liên hệ QC

macduong2008

Thành viên mới
Tham gia
2/12/18
Bài viết
4
Được thích
0
Em có danh sách điểm các em hs thi các môn khác nhau (Lý, hoá, sử, địa) và 1 ds K12 gồm tất cả các em đăng ký thi. Bây giờ em muốn tìm kiếm theo số báo danh hoặc tên của em đó ở sheet Ly rồi lấy điểm đưa vào cột lý.
Em có file kèm theo.
Vậy nhờ các bác giúp cho. Em xin cảm ơn!
 

File đính kèm

  • Điểm 1.xlsx
    67.6 KB · Đọc: 9
Em có danh sách điểm các em hs thi các môn khác nhau (Lý, hoá, sử, địa) và 1 ds K12 gồm tất cả các em đăng ký thi. Bây giờ em muốn tìm kiếm theo số báo danh hoặc tên của em đó ở sheet Ly rồi lấy điểm đưa vào cột lý.
Em có file kèm theo.
Vậy nhờ các bác giúp cho. Em xin cảm ơn!
Bạn dùng VBA không.
 
Em có danh sách điểm các em hs thi các môn khác nhau (Lý, hoá, sử, địa) và 1 ds K12 gồm tất cả các em đăng ký thi. Bây giờ em muốn tìm kiếm theo số báo danh hoặc tên của em đó ở sheet Ly rồi lấy điểm đưa vào cột lý.
Em có file kèm theo.
Vậy nhờ các bác giúp cho. Em xin cảm ơn!
Để giải quyết trường hợp này, tôi có ý tưởng như sau:
- Tạo 1 danh sách Tên môn học không dấu để đồng nhất với tên Sheet chi tiết các môn học (trong file là vùng G3:O3)
- Sử dụng hàm Indirect() để dẫn chiếu đến các sheet tương ứng với Tên môn học
- Sử dùng hàm Vlookup() với điều kiện tìm kiếm là mã học sinh để tra cứu điểm
Bạn xem file đính kèm.
 

File đính kèm

  • Điểm 1.xlsx
    66.7 KB · Đọc: 9
Có VBA thì tốt quá. Thank!
Bài đã được tự động gộp:

Để giải quyết trường hợp này, tôi có ý tưởng như sau:
- Tạo 1 danh sách Tên môn học không dấu để đồng nhất với tên Sheet chi tiết các môn học (trong file là vùng G3:O3)
- Sử dụng hàm Indirect() để dẫn chiếu đến các sheet tương ứng với Tên môn học
- Sử dùng hàm Vlookup() với điều kiện tìm kiếm là mã học sinh để tra cứu điểm
Bạn xem file đính kèm.
Cảm ơn bạn! Cách của bạn ổn rồi. Làm sao để những em không có điểm thì ko bị NA?
 
Có VBA thì tốt quá. Thank!
Bài đã được tự động gộp:


Cảm ơn bạn! Cách của bạn ổn rồi. Làm sao để những em không có điểm thì ko bị NA?
Đây bạn xem.
Mã:
Sub tinhdiem()
Dim arr, arr1
Dim a As Long, b As Long, c As Long, i As Long, j As Long
Dim dic As Object
Dim s, s1 As String, dk As String
Set dic = CreateObject("scripting.dictionary")
dic.CompareMode = vbTextCompare
Dim sh As Worksheet
For Each sh In Application.Sheets
    If sh.Name <> "K12" Then
      arr = sh.Range("B5:E" & sh.Range("B" & Rows.Count).End(xlUp).Row).Value
      s = Split(" " & sh.Range("C3").Value, " ")
      c = UBound(s)
      s1 = s(c)
      For i = 1 To UBound(arr, 1)
          dk = s1 & arr(i, 1)
          If dic.exists(dk) = 0 Then
              dic.Item(dk) = Array(arr(i, 4))
          End If
      Next i
      Erase arr
   End If
Next
With Sheets("K12")
    arr1 = .Range("B4:o" & .Range("c" & Rows.Count).End(xlUp).Row).Value
    For i = 2 To UBound(arr1, 1)
        For j = 6 To UBound(arr1, 2)
            dk = arr1(1, j) & arr1(i, 2)
            If dic.exists(dk) Then
                arr1(i, j) = dic.Item(dk)(0)
             Else
                arr1(i, j) = Empty
             End If
         Next j
    Next i
    .Range("B4").Resize(UBound(arr1, 1), UBound(arr1, 2)).Value = arr1
End With
End Sub
 

File đính kèm

  • Điểm 1 (1).xlsm
    67.9 KB · Đọc: 10
Đang rảnh việc :)
Mã:
Sub GPE()
  Dim sArr(), Res(), S As Variant
  Dim Dic As Object, sh As Worksheet
  Dim sRow As Long, i As Long, ik As Long, j As Byte, jCol As Byte
 
  Set Dic = CreateObject("scripting.dictionary")
  With Sheets("K12")
    i = .Range("c" & Rows.Count).End(xlUp).Row
    If i < 5 Then MsgBox ("khong co Hoc Sinh"): Exit Sub
    j = Range("AAA4").End(xlToLeft).Column
    If j < 7 Then MsgBox ("khong co Mon Hoc"): Exit Sub
    sArr = .Range("C5:C" & i).Value
    sRow = UBound(sArr, 1)
    For i = 1 To sRow
      If Len(sArr(i, 1)) > 0 Then Dic.Item(sArr(i, 1)) = i
    Next i
    sArr = .Range("G4", .Cells(4, j)).Value
    For j = 1 To UBound(sArr, 2)
      If Len(sArr(1, j)) > 0 Then Dic.Item(UCase(sArr(1, j))) = j
    Next j
    ReDim Res(1 To sRow, 1 To UBound(sArr, 2))
  End With
 
  For Each sh In ThisWorkbook.Sheets
    If sh.Name <> "K12" Then
      S = Split(" " & Application.Trim(sh.Range("C3").Value), " ")
      jCol = Dic.Item(UCase(S(UBound(S))))
      If jCol > 0 Then
        i = sh.Range("B" & Rows.Count).End(xlUp).Row
        If i > 4 Then
          sArr = sh.Range("B5:E" & i).Value
          For i = 1 To UBound(sArr, 1)
            ik = Dic.Item(sArr(i, 1))
            If ik > 0 Then Res(ik, jCol) = sArr(i, 4)
          Next i
        End If
      End If
    End If
  Next
  Sheets("K12").Range("G5").Resize(sRow, UBound(Res, 2)) = Res
End Sub
 
Đang rảnh việc :)
Mã:
Sub GPE()
  Dim sArr(), Res(), S As Variant
  Dim Dic As Object, sh As Worksheet
  Dim sRow As Long, i As Long, ik As Long, j As Byte, jCol As Byte

  Set Dic = CreateObject("scripting.dictionary")
  With Sheets("K12")
    i = .Range("c" & Rows.Count).End(xlUp).Row
    If i < 5 Then MsgBox ("khong co Hoc Sinh"): Exit Sub
    j = Range("AAA4").End(xlToLeft).Column
    If j < 7 Then MsgBox ("khong co Mon Hoc"): Exit Sub
    sArr = .Range("C5:C" & i).Value
    sRow = UBound(sArr, 1)
    For i = 1 To sRow
      If Len(sArr(i, 1)) > 0 Then Dic.Item(sArr(i, 1)) = i
    Next i
    sArr = .Range("G4", .Cells(4, j)).Value
    For j = 1 To UBound(sArr, 2)
      If Len(sArr(1, j)) > 0 Then Dic.Item(UCase(sArr(1, j))) = j
    Next j
    ReDim Res(1 To sRow, 1 To UBound(sArr, 2))
  End With

  For Each sh In ThisWorkbook.Sheets
    If sh.Name <> "K12" Then
      S = Split(" " & Application.Trim(sh.Range("C3").Value), " ")
      jCol = Dic.Item(UCase(S(UBound(S))))
      If jCol > 0 Then
        i = sh.Range("B" & Rows.Count).End(xlUp).Row
        If i > 4 Then
          sArr = sh.Range("B5:E" & i).Value
          For i = 1 To UBound(sArr, 1)
            ik = Dic.Item(sArr(i, 1))
            If ik > 0 Then Res(ik, jCol) = sArr(i, 4)
          Next i
        End If
      End If
    End If
  Next
  Sheets("K12").Range("G5").Resize(sRow, UBound(Res, 2)) = Res
End Sub
Code của anh Hiếu nhanh thật đấy.Tối ưu được vòng lặp.
 
Đang rảnh việc :)
Mã:
Sub GPE()
  Dim sArr(), Res(), S As Variant
  Dim Dic As Object, sh As Worksheet
  Dim sRow As Long, i As Long, ik As Long, j As Byte, jCol As Byte

  Set Dic = CreateObject("scripting.dictionary")
  With Sheets("K12")
    i = .Range("c" & Rows.Count).End(xlUp).Row
    If i < 5 Then MsgBox ("khong co Hoc Sinh"): Exit Sub
    j = Range("AAA4").End(xlToLeft).Column
    If j < 7 Then MsgBox ("khong co Mon Hoc"): Exit Sub
    sArr = .Range("C5:C" & i).Value
    sRow = UBound(sArr, 1)
    For i = 1 To sRow
      If Len(sArr(i, 1)) > 0 Then Dic.Item(sArr(i, 1)) = i
    Next i
    sArr = .Range("G4", .Cells(4, j)).Value
    For j = 1 To UBound(sArr, 2)
      If Len(sArr(1, j)) > 0 Then Dic.Item(UCase(sArr(1, j))) = j
    Next j
    ReDim Res(1 To sRow, 1 To UBound(sArr, 2))
  End With

  For Each sh In ThisWorkbook.Sheets
    If sh.Name <> "K12" Then
      S = Split(" " & Application.Trim(sh.Range("C3").Value), " ")
      jCol = Dic.Item(UCase(S(UBound(S))))
      If jCol > 0 Then
        i = sh.Range("B" & Rows.Count).End(xlUp).Row
        If i > 4 Then
          sArr = sh.Range("B5:E" & i).Value
          For i = 1 To UBound(sArr, 1)
            ik = Dic.Item(sArr(i, 1))
            If ik > 0 Then Res(ik, jCol) = sArr(i, 4)
          Next i
        End If
      End If
    End If
  Next
  Sheets("K12").Range("G5").Resize(sRow, UBound(Res, 2)) = Res
End Sub
Anh có thể giải thích giúp em những dòng code này không?
j = Range("AAA4").End(xlToLeft).Column
sArr = .Range("G4", .Cells(4, j)).Value

Em cảm ơn Anh!
 
Anh có thể giải thích giúp em những dòng code này không?
j = Range("AAA4").End(xlToLeft).Column
sArr = .Range("G4", .Cells(4, j)).Value

Em cảm ơn Anh!
Cái j là xác định vị trí cột cuối cùng của dong số 4.
Còn câu lệnh thứ 2 là.Gán giá trị cho sArr theo giá trị của vòng lặp với j.Mỗi một lần j thay đổi thì.sArr thay đổi theo.
 
Cái j là xác định vị trí cột cuối cùng của dong số 4.
Còn câu lệnh thứ 2 là.Gán giá trị cho sArr theo giá trị của vòng lặp với j.Mỗi một lần j thay đổi thì.sArr thay đổi theo.
Cho em hỏi tại sao là Range("AAA4"), mà em thấy trong file không có vùng đó,
 
Cho em hỏi tại sao là Range("AAA4"), mà em thấy trong file không có vùng đó,
Range("AAA4") là anh Hiếu anh xác định cột cuối cùng của dữ liệu ngược trở về bên trái đến giá trị đầu tiên có dữ liệu đó.Cái này tùy ý bạn nhé.
 
Lần chỉnh sửa cuối:
Range("AAA4") là anh Hiệp anh xác định cột cuối cùng của dữ liệu ngược trở về bên trái đến giá trị đầu tiên có dữ liệu đó.Cái này tùy ý bạn nhé.
Việc xác định cột cuối cùng có dữ liệu của 1 dòng khi sử dụng Range("AAA4") tương tự như bạn gặp 1 số trường hợp xác định dòng cuối cùng có dữ liệu như:
PHP:
Range("A65000").End(xlup).Row
Còn nếu bạn không muốn chọn 1 ô cụ thể thì có thể dùng code sau:
PHP:
Cells(4,columns.count).end(xltoleft).column
 
Thực sự rất tuyệt vời!
Xin cảm ơn AE đã nỗ lực hỗ trợ em hết mình.
Em xin cảm ơn!
 
Web KT
Back
Top Bottom