Giúp đỡ code copy thống kê dữ liệu từ nhiều bảng (1 người xem)

kimanh17 · 24/11/16

Chào mọi người trong diễn đàn, mình có một vấn đề mong giúp đỡ
mình có nhiều file điểm và có 1 file tổng hợp dữ liệu có cách nào ở file tổng hợp dữ liệu khi bấm vào nút thì sẽ copy cột diem TBHK ở các file khác vào không? mong giúp đỡ ạ!!

kimanh17 · 29/11/16

befaint đã viết:
Bạn xem file đính kèm nhé!

Cám ơn bạn rất nhiều!! }}}}}

kimanh17 · 29/11/16

befaint đã viết:
Bạn xem file đính kèm nhé!

Xin lỗi bạn cho mình hỏi thêm vấn đề nữa là mình chỉ cần dựa theo tên thôi, ko cần cả họ và tên, mình đã sửa những chỗ này nhưng ko đúng bạn có thể chỉ vị trí nào dc ko ạ?

Sub TkDiem()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Ipath As String, iMon() As Variant, Mon(), TB(), HT(), T As String, tmp()
Dim i As Integer, k As Byte, er As Long, lr As Long, r As Long, ir As Long
er = Sheet1.Range("C65000").End(xlUp).Row
HT = Sheet1.Range("C5:C" & er).Value
Ipath = GetFolder(""): If Ipath = "" Then Exit Sub
iMon = GetFileList(Ipath)
Mon = Sheet1.Range("E4:L4").Value
ReDim TB(1 To UBound(HT, 1), 1 To UBound(Mon, 2))
For i = 1 To UBound(iMon)
For k = 1 To UBound(Mon, 2)
If Replace(iMon(i), ".xlsx", "") Like "*" & Mon(1, k) Then
Workbooks.Open Filename:=Ipath & "" & iMon(i), ReadOnly:=True
With ActiveWorkbook.Sheets("Sheet1")
lr = .Range("C65000").End(xlUp).Row
tmp = .Range("B3:R" & lr).Value
For r = 1 To UBound(TB, 1)
T = UCase(Replace(HT(r, 1), " ", ""))
For ir = 1 To UBound(tmp, 1)
If T = UCase(Replace(tmp(ir, 1) & tmp(ir, 2), " ", "")) Then
TB(r, k) = tmp(ir, UBound(tmp, 2)): Exit For
End If
Next ir
Next r
End With
Workbooks(iMon(i)).Close
End If
Next k
Next i
Sheet1.Range("E5").Resize(UBound(TB, 1), UBound(TB, 2)).ClearContents
Sheet1.Range("E5").Resize(UBound(TB, 1), UBound(TB, 2)).NumberFormat = "0.0"
Sheet1.Range("E5").Resize(UBound(TB, 1), UBound(TB, 2)).Value = TB
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

befaint · 29/11/16

kimanh17 đã viết:
Xin lỗi bạn cho mình hỏi thêm vấn đề nữa là mình chỉ cần dựa theo tên thôi, ko cần cả họ và tên, mình đã sửa những chỗ này nhưng ko đúng bạn có thể chỉ vị trí nào dc ko ạ?

Cả họ và tên còn có trường hợp TRÙNG!!! Chỉ theo tên thôi là tèo rồi còn đâu.
p/s: Cái này người ta phải tạo Mã cho mỗi học sinh, Mã đó là duy nhất.

kimanh17 · 29/11/16

befaint đã viết:
Cả họ và tên còn có trường hợp TRÙNG!!! Chỉ theo tên thôi là tèo rồi còn đâu.
p/s: Cái này người ta phải tạo Mã cho mỗi học sinh, Mã đó là duy nhất.

Vậy nếu thêm mã thì sẽ phải sửa lại code ở vị trí nào ạ?

befaint · 29/11/16

kimanh17 đã viết:
Vậy nếu thêm mã thì sẽ phải sửa lại code ở vị trí nào ạ?

Thêm mã thì:
- Việc đầu tiên tạo cái mã đó đã, gồm bao nhiêu ký tự (chữ / số)?
- Tiếp đến, gán mã đó ứng với mỗi học sinh ở tất cả các bảng dữ liệu, đặt tại cột trước cột [Họ và tên đệm]
- Xong xuôi mới tính tới code. Cái này thì đơn giản vì đã cột [Mã] để tham chiếu. Cứ lấy mã so với nhau, trùng thì lấy dữ liệu tương ứng. Nhàn hơn so với việc so sánh họ và tên.

kimanh17 · 29/11/16

befaint đã viết:
Thêm mã thì: - Việc đầu tiên tạo cái mã đó đã, gồm bao nhiêu ký tự (chữ / số)? - Tiếp đến, gán mã đó ứng với mỗi học sinh ở tất cả các bảng dữ liệu, đặt tại cột trước cột [Họ và tên đệm] - Xong xuôi mới tính tới code. Cái này thì đơn giản vì đã cột [Mã] để tham chiếu. Cứ lấy mã so với nhau, trùng thì lấy dữ liệu tương ứng. Nhàn hơn so với việc so sánh họ và tên.

Ví dụ như Mã là HS001 vậy phải sửa thế nào bạn? mình mới tìm hiểu nên ko biết gì cả, mong giúp đỡ ạ

befaint · 29/11/16

kimanh17 đã viết:
Ví dụ như Mã là HS001 vậy phải sửa thế nào bạn? mình mới tìm hiểu nên ko biết gì cả, mong giúp đỡ ạ

Bạn làm xong hẳn bước 2 đi đã:

- Tiếp đến, gán mã đó ứng với mỗi học sinh ở tất cả các bảng dữ liệu, đặt tại cột trước cột [Họ và tên đệm]

Còn ở các bảng tổng hợp điểm nữa.

kimanh17 · 29/11/16

befaint đã viết:
Bạn làm xong hẳn bước 2 đi đã:

Còn ở các bảng tổng hợp điểm nữa.

Mình sửa rồi đây bạn!!

befaint · 29/11/16

kimanh17 đã viết:
Mình sửa rồi đây bạn!!

Bạn thử đoạn sau:

Mã:

Sub TkDiem()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Ipath As String, iMon() As Variant, Mon(), TB(), MA(), tmp()
Dim i As Integer, k As Byte, er As Long, lr As Long, r As Long, ir As Long
er = Sheet1.Range("C65000").End(xlUp).Row
MA = Sheet1.Range("B5:B" & er).Value
Ipath = GetFolder(""): If Ipath = "" Then Exit Sub
iMon = GetFileList(Ipath)
Mon = Sheet1.Range("E4:L4").Value
ReDim TB(1 To UBound(MA, 1), 1 To UBound(Mon, 2))
For i = 1 To UBound(iMon)
    For k = 1 To UBound(Mon, 2)
        If Replace(iMon(i), ".xlsx", "") Like "*" & Mon(1, k) Then
            Workbooks.Open Filename:=Ipath & "\" & iMon(i), ReadOnly:=True
            With ActiveWorkbook.Sheets("Sheet1")
                lr = .Range("C65000").End(xlUp).Row
                tmp = .Range("A3:R" & lr).Value
                For r = 1 To UBound(TB, 1)
                    For ir = 1 To UBound(tmp, 1)
                        If MA(r, 1) = tmp(ir, 1) Then
                            TB(r, k) = tmp(ir, UBound(tmp, 2)): Exit For
                        End If
                    Next ir
                Next r
            End With
            Workbooks(iMon(i)).Close
        End If
    Next k
Next i
Sheet1.Range("E5").Resize(UBound(TB, 1), UBound(TB, 2)).ClearContents
Sheet1.Range("E5").Resize(UBound(TB, 1), UBound(TB, 2)).NumberFormat = "0.0"
Sheet1.Range("E5").Resize(UBound(TB, 1), UBound(TB, 2)).Value = TB
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

kimanh17 · 29/11/16

befaint đã viết:

Bạn thử đoạn sau:

Mã:

Sub TkDiem()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Ipath As String, iMon() As Variant, Mon(), TB(), MA(), tmp()
Dim i As Integer, k As Byte, er As Long, lr As Long, r As Long, ir As Long
er = Sheet1.Range("C65000").End(xlUp).Row
MA = Sheet1.Range("B5:B" & er).Value
Ipath = GetFolder(""): If Ipath = "" Then Exit Sub
iMon = GetFileList(Ipath)
Mon = Sheet1.Range("E4:L4").Value
ReDim TB(1 To UBound(MA, 1), 1 To UBound(Mon, 2))
For i = 1 To UBound(iMon)
    For k = 1 To UBound(Mon, 2)
        If Replace(iMon(i), ".xlsx", "") Like "*" & Mon(1, k) Then
            Workbooks.Open Filename:=Ipath & "\" & iMon(i), ReadOnly:=True
            With ActiveWorkbook.Sheets("Sheet1")
                lr = .Range("C65000").End(xlUp).Row
                tmp = .Range("A3:R" & lr).Value
                For r = 1 To UBound(TB, 1)
                    For ir = 1 To UBound(tmp, 1)
                        If MA(r, 1) = tmp(ir, 1) Then
                            TB(r, k) = tmp(ir, UBound(tmp, 2)): Exit For
                        End If
                    Next ir
                Next r
            End With
            Workbooks(iMon(i)).Close
        End If
    Next k
Next i
Sheet1.Range("E5").Resize(UBound(TB, 1), UBound(TB, 2)).ClearContents
Sheet1.Range("E5").Resize(UBound(TB, 1), UBound(TB, 2)).NumberFormat = "0.0"
Sheet1.Range("E5").Resize(UBound(TB, 1), UBound(TB, 2)).Value = TB
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Vâng, cám ơn bạn nhiều!!

kimanh17 · 29/11/16

befaint đã viết:

Bạn thử đoạn sau:

Mã:

Sub TkDiem()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Ipath As String, iMon() As Variant, Mon(), TB(), MA(), tmp()
Dim i As Integer, k As Byte, er As Long, lr As Long, r As Long, ir As Long
er = Sheet1.Range("C65000").End(xlUp).Row
MA = Sheet1.Range("B5:B" & er).Value
Ipath = GetFolder(""): If Ipath = "" Then Exit Sub
iMon = GetFileList(Ipath)
Mon = Sheet1.Range("E4:L4").Value
ReDim TB(1 To UBound(MA, 1), 1 To UBound(Mon, 2))
For i = 1 To UBound(iMon)
    For k = 1 To UBound(Mon, 2)
        If Replace(iMon(i), ".xlsx", "") Like "*" & Mon(1, k) Then
            Workbooks.Open Filename:=Ipath & "\" & iMon(i), ReadOnly:=True
            With ActiveWorkbook.Sheets("Sheet1")
                lr = .Range("C65000").End(xlUp).Row
                tmp = .Range("A3:R" & lr).Value
                For r = 1 To UBound(TB, 1)
                    For ir = 1 To UBound(tmp, 1)
                        If MA(r, 1) = tmp(ir, 1) Then
                            TB(r, k) = tmp(ir, UBound(tmp, 2)): Exit For
                        End If
                    Next ir
                Next r
            End With
            Workbooks(iMon(i)).Close
        End If
    Next k
Next i
Sheet1.Range("E5").Resize(UBound(TB, 1), UBound(TB, 2)).ClearContents
Sheet1.Range("E5").Resize(UBound(TB, 1), UBound(TB, 2)).NumberFormat = "0.0"
Sheet1.Range("E5").Resize(UBound(TB, 1), UBound(TB, 2)).Value = TB
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Hình như nếu xóa tên đi thì code này ko chạy đc nữa bạn ơi....

befaint · 29/11/16

kimanh17 đã viết:
Hình như nếu xóa tên đi thì code này ko chạy đc nữa bạn ơi....

Bạn ơi. Bạn từ từ diễn đạt có đầu có cuối để người khác hiểu mà xem giúp bạn.

Bạn xóa tên là xóa tên gì? Tên môn học? Tên học sinh?

Xóa thì xóa như nào? Xóa giá trị hay xóa cả dòng/ cột?

Cấu trúc dữ liệu sau khi xóa có thay đổi gì không so với trước khi xóa?

Thứ nữa, bạn có chạy đúng code căn cứ vào Mã để tham chiếu (bài #29)?

Ngoài ra, nếu được thì bạn gửi file sau khi xóa lên cho trực quan, dễ hiểu cái bạn vừa xóa là gì? Bớt phải giải thích nhiều.

Bạn phản hồi lại nhé.

kimanh17 · 29/11/16

befaint đã viết:
Bạn ơi. Bạn từ từ diễn đạt có đầu có cuối để người khác hiểu mà xem giúp bạn.

Bạn xóa tên là xóa tên gì? Tên môn học? Tên học sinh?

Xóa thì xóa như nào? Xóa giá trị hay xóa cả dòng/ cột?

Cấu trúc dữ liệu sau khi xóa có thay đổi gì không so với trước khi xóa?

Thứ nữa, bạn có chạy đúng code căn cứ vào Mã để tham chiếu (bài #29)?

Ngoài ra, nếu được thì bạn gửi file sau khi xóa lên cho trực quan, dễ hiểu cái bạn vừa xóa là gì? Bớt phải giải thích nhiều.

Bạn phản hồi lại nhé.

xin lỗi do mình nói ko rõ ràng, ý mình là xóa dữ liệu trong cột họ va tên chỉ xóa dữ liệu thôi vị trí cột vẫn giữ nguyên chỉ dựa vào Mahs để chạy code lấy điểm thì ko đc!! Làm phiền bạn quá do lúc này mình đang lên bằng điện thoại nên ko gửi file lên đc nếu đc sáng mình sẽ gửi lên ạ +-+-+-+

befaint · 29/11/16

kimanh17 đã viết:
xin lỗi do mình nói ko rõ ràng, ý mình là xóa dữ liệu trong cột họ va tên chỉ xóa dữ liệu thôi vị trí cột vẫn giữ nguyên chỉ dựa vào Mahs để chạy code lấy điểm thì ko đc!! Làm phiền bạn quá do lúc này mình đang lên bằng điện thoại nên ko gửi file lên đc nếu đc sáng mình sẽ gửi lên ạ

Xóa đi thì lấy gì mà tổng hợp?
Có mã thì mới có họ và tên. Không lẽ có mã nhưng không có họ tên và vẫn có điểm số? kỳ lạ ghê cơ.
Bạn tìm hai dòng:

Mã:

er = Sheet1.Range("C65000").End(xlUp).Row
...
lr = .Range("C65000").End(xlUp).Row

sửa thành:

Mã:

er = Sheet1.Range("B65000").End(xlUp).Row
...
lr = .Range("A65000").End(xlUp).Row

Giúp đỡ code copy thống kê dữ liệu từ nhiều bảng (1 người xem)

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

kimanh17

Thành viên mới

File đính kèm

kimanh17

Thành viên mới

kimanh17

Thành viên mới

befaint

|||||||||||||

kimanh17

Thành viên mới

befaint

|||||||||||||

kimanh17

Thành viên mới

File đính kèm

befaint

|||||||||||||

kimanh17

Thành viên mới

File đính kèm

befaint

|||||||||||||

kimanh17

Thành viên mới

kimanh17

Thành viên mới

befaint

|||||||||||||

kimanh17

Thành viên mới

befaint

|||||||||||||

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

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

Đếm ngược thời gian