Xin hoàn thiện code vba tổng hợp dữ liệu từ các sheet con (1 người xem)

[congatrong82]

Mình có 47 file danh sách biên chế CB-GV-NV trường Tiểu học. 47 file này khi nhập xong (số lượng các trường không giống nhau, nhưng tối đa là 120 người). Xong bấm vào nút NHẬP DL sẽ được tổng hợp từ 47 Sheet trường sang Sheet DANH SACH TONG HOP BIEN CHE GIAO VIEN-NV 13-14_Link cac sheet con.xls (vùng B131212)

Kết quả dựa vào tên trường ở cột (Y14:Y59). Các tên trường em làm giống như tên Sheet trường con.

Xin các thành viên GPE giúp dùm mình nhé. Mình cảm ơn anh nhiều.

File mình gởi kèm.

 

[toantopsun]

haiz. thông tin nghe vẻ hữu dụng đây

 

[be_09]

Kiểm tra hoặc thay bằng Link mới, vì:

Still not downloading?

Không thể download được.

 

[congatrong82]

Kiểm tra hoặc thay bằng Link mới, vì:

Still not downloading?

Không thể download được.

Đã sửa link rồi bạn ơi. Xin GPE giúp mình với.

 

[sealand]

Có nhiều cách làm có tính khoa học hơn như sử dụng ADO,DAO v.v... nhưng nó đòi hỏi kỹ thuật cao.
Mình giúp bạn 1 cách "đời thường" nhất là mở nó ra, chép lấy dữ liệu rồi đóng trả.

Private Sub CommandButton1_Click()
Dim Tm, i, Dg, fName As String
Dim Wb As Workbook, Sh As Worksheet, Cl As Range
Application.ScreenUpdating = False
Tm = Sheet1.[Y14:Y60]
Sheet1.Range("B13:P10000").ClearContents
Set Cl = Sheet1.[B13]
For i = 1 To UBound(Tm, 1)
fName = ThisWorkbook.Path & "\" & Tm(i, 1) & ".xls"
If Dir(fName) <> "" Then 'Kiem tra file co ton tai khong
Set Wb = Application.Workbooks.Open(fName)
Set Sh = Wb.Worksheets("Danhsach")
Dg = Sh.Range("Q11")
If Dg > 0 Then
Cl.Resize(Dg, 15).Value = Sh.[B13].Resize(Dg, 15).Value
Set Cl = Cl.Offset(Dg)
End If
Wb.Close False
End If
Next
Application.ScreenUpdating = True
End Sub

Bạn chép trả file kèm vào thư mục TIEU HOC rồi test thử nha

 

[congatrong82]

Cảm ơn bạn nha. Mình vừa test thử nhưng kết quả không đúng bạn ơi.
Có 1 trường 22 người.
còn lại 46 trường x 9 người = 414 + 22 = 436
Kết quả test thử là 400.
Bạn xem lại giúp.

 

[sealand]

Code không đúng hay bạn không đúng ?

Bạn chép file này vào chạy để biết lý do nha. Mình đã bổ xung thêm phần tổng hợp lỗi không Tổng hợp danh sách

 

[congatrong82]

Cảm ơn bạn nhiều nha.
Giờ mình thay code Tm = Sheet1.[Y14:Y60] bằng
Tm = Sheet1.[Z14:Z31] để chay cho cấp THCS

 

[sealand]

Bạn dùng Code sau để chọn cấp nha: (Thay vùng mình đánh dấu đỏ)

Private Sub CommandButton1_Click()
Dim Tm, i, Dg, fName As String, Tb As String, Cap
Cap = InputBox("Nhap cap tong hop: 1 hoac 2 hoac 3")
If Cap <> 1 And Cap <> 2 And Cap <> 3 Then Exit Sub
Dim Wb As Workbook, Sh As Worksheet, Cl As Range
Application.ScreenUpdating = False
Select Case Cap
Case Is = 1
Tm = Sheet1.[Y14:Y60]
Case Is = 2
Tm = [B][COLOR=#ff0000]Sheet1.[Y14:Y60][/COLOR][/B] 'Thay vung nay bang Cap2
Case Is = 3
Tm = [B][COLOR=#ff0000]Sheet1.[Y14:Y60][/COLOR][/B] 'Thay vung nay bang Cap3
End Select
Sheet1.Range("B13:P10000").ClearContents
Set Cl = Sheet1.[B13]
For i = 1 To UBound(Tm, 1)
fName = ThisWorkbook.Path & "\" & Tm(i, 1) & ".xls"
If Dir(fName) <> "" Then 'Kiem tra file co ton tai khong
Set Wb = Application.Workbooks.Open(fName)
Set Sh = Wb.Worksheets("Danhsach")
Dg = Sh.Range("Q11")
'Dg = WorksheetFunction.Max(Sh.[A13:A200])
If Dg > 0 Then
Cl.Resize(Dg, 15).Value = Sh.[B13].Resize(Dg, 15).Value
Set Cl = Cl.Offset(Dg)
End If
Wb.Close False
Else
Tb = Tb & IIf(Tb <> "", Chr(13), "") & fName
End If
Next
If Tb = "" And Cl.Address <> "$B$13" Then
Tb = "Tong Hop thanh cong!!!"
Else
Tb = "Kiem tra loi khong tim thay cac file sau: " & Chr(13) & Chr(13) & Tb
End If
MsgBox Tb
Application.ScreenUpdating = True
End Sub

 

[congatrong82]

Bạn có thể thêm code ẩn vùng trống (ví dụ: copy số liệu không đến cột B1212) được không bạn. Code #7 rất tốt. Mình áp dụng code này.

 

[sealand]

Sheet của bạn thật khó xác định theo cách bình thường được vì nó là bảng có chân. Ví dụ danh sách của bạn có 9 người nhưng dòng 156 bạn vẫn có dữ liệu ghi chép khác.
Trong code của mình đã xác định chép đến hết danh sách thì thôi. Bạn nghiên cứu xem có đúng vậy không?

 

[congatrong82]

Uh. Đúng vậy rồi bạn ơi. Nhưng cho mình hỏi sau mình dùng công thức để lấy dữ liệu qua Sheet2 để sắp xếp theo từng đơn vị nhưng khi kéo công thức không tự nhảy được. Bạn có cách khắc phục không?
File đính kèm.