Cách code trích rút dữ liệu từ một file báo cáo vào một file báo cáo tổng hợp (1 người xem)

[axn125]

Chào các anh/chị !
Em đang muốn làm một file tổng hợp báo cáo, dữ liệu được trích rút từ các file báo cáo con sau đó dữ liệu được tổng hợp lại vào trong file tổng hợp.
Em đã code được cái nút mở file.
Các anh/chị giúp cái thuật toán sau khi mở file thì ta chép dữ liệu từ sheet "Mau 01" chép theo cách mô tả có ghi trong file đính kèm và đưa vào file MasterTH
Chân thành cảm ơn các anh/chị

 

[doveandrose]

cái này gõ công thức không được sao bạn ?
='[PL01-75902001.xls]Mau 01'!$C$8

 

[axn125]

Nếu dùng cách này thì các cột Quý sau không chạy được, làm vậy dữ liệu chỉ được lấy ở cột C thôi

 

[axn125]

Ta có thể làm theo đối tượng Form không ?
Ta cho chọn Quý và Năm cần trích rút -> Chọn OPEN FILE -> khi chọn và rồi mở file, ta cho rút dữ liệu từ cột tương ứng trong các file báo cáo và đưa dữ liệu vào file tổng hợp MasterTH

 

[sealand]

Phương án sử lý của bạn chưa hợp lý cần điều chỉnh lại, theo mình hiểu thì cơ cấu hoạt động của bạn nên như thế này:

1-Code sẽ xoá đưa báo cáo về mẫu biểu trắng.
2-Tạo danh sách các thời điểm chốt dữ liệu như trên các file chi tiết đã tổng hợp. Căn cứ thời gian để chọn cột chép cho phù hợp.
3-Không cần GetOpenFileName là gì nữa, căn cứ giá trị từng ô trong cột B của Mau 01 MasterTH để mở file tương ứng để chép trên Mau 01 cột tương ứng thời gian chọn trên và điền vào dòng tương ứng trên MasterTH

 

[axn125]

Phương án sử lý của bạn chưa hợp lý cần điều chỉnh lại, theo mình hiểu thì cơ cấu hoạt động của bạn nên như thế này:

1-Code sẽ xoá đưa báo cáo về mẫu biểu trắng.
2-Tạo danh sách các thời điểm chốt dữ liệu như trên các file chi tiết đã tổng hợp. Căn cứ thời gian để chọn cột chép cho phù hợp.
3-Không cần GetOpenFileName là gì nữa, căn cứ giá trị từng ô trong cột B của Mau 01 MasterTH để mở file tương ứng để chép trên Mau 01 cột tương ứng thời gian chọn trên và điền vào dòng tương ứng trên MasterTH

Code được viết như thế nào vậy ?

 

[sealand]

Code the này,

Sub GetData()
Dim FName As String, eCol As Integer, i, j, Tb(), OldVal(1 To 2) As Boolean
Dim Wb As Workbook, Sh As Worksheet
On Error Resume Next
Tb = Array("1: T5/2015", "2: Q3/2015", "3: Q4/2015", "4: Q1/2016", _
"5: Q2/2016", "6: Q3/2016", "7: Q4/2016", "8: Q1/2017", "9: T5/2017")
Do While InStr(1, "1,2,3,4,5,6,7,8,9", eCol) = 0
eCol = InputBox("Nhap so tuong ung tung thoi ky" & Chr(13) & Join(Tb, Chr(13)))
Loop
OldVal(1) = Application.ScreenUpdating: If OldVal(1) Then Application.ScreenUpdating = False
OldVal(2) = Application.DisplayAlerts: If OldVal(2) Then Application.DisplayAlerts = False
Sheet1.[C8:Q42].ClearContents
Do
i = IIf(i = 0, 8, i + 1)
FName = ThisWorkbook.Path & "\PL01-" & Sheet1.Cells(i, "B") & ".xls"
If Dir(FName) <> "" Then
Set Wb = Workbooks.Open(FName)
Set Sh = Wb.Worksheets("Mau 01")
Sheet1.Cells(i, 3).Resize(, 4) = WorksheetFunction.Transpose(Sh.Cells(8, eCol + 2).Resize(4))
Sheet1.Cells(i, 9).Resize(, 9) = WorksheetFunction.Transpose(Sh.Cells(12, eCol + 2).Resize(9))
Set Sh = Nothing
Wb.Close
Set Wb = Nothing
End If
Loop Until Sheet1.Cells(i, "B") = ""
Application.ScreenUpdating = OldVal(1)
Application.DisplayAlerts = OldVal(2)
End Sub

 

[axn125]

Cảm ơn Sealand rất nhiều, có phần code này mình chưa hiểu lắm. Anh Sealand có thể giải thích thêm một chút được không

i = IIf(i = 0, 8, i + 1) FName = ThisWorkbook.Path & "\PL01-" & Sheet1.Cells(i, "B") & ".xls"
If Dir(FName) <> "" Then
Set Wb = Workbooks.Open(FName)
Set Sh = Wb.Worksheets("Mau 01")
Sheet1.Cells(i, 3).Resize(, 4) = WorksheetFunction.Transpose(Sh.Cells(8, eCol + 2).Resize(4))
Sheet1.Cells(i, 9).Resize(, 9) = WorksheetFunction.Transpose(Sh.Cells(12, eCol + 2).Resize(9))
Set Sh = Nothing
Wb.Close
Set Wb = Nothing
End If
Loop Until Sheet1.Cells(i, "B") = ""
Application.ScreenUpdating = OldVal(1)
Application.DisplayAlerts = OldVal(2)

 

[doveandrose]

Cảm ơn Sealand rất nhiều, có phần code này mình chưa hiểu lắm. Anh Sealand có thể giải thích thêm một chút được không

bạn thích làm kiểu chọn file cũng được . vì cũng có khi file cần lấy không nằm chung folder với file tổng hợp . code ở trên áp dụng cho các file con nằm chung trong file tổng hợp
nhưng có cái tôi thắc mắc là :
ví dụ bạn chọn file PL01-75902001.xls và lấy dữ liệu trong cột C thì các file PL01-75902002.xls,PL01-75902003.xls,... có lấy dữ liệu trong cột C không hay là phải chọn lại cho từng file ?
nếu chỉ cần chọn 1 lần cột C cho tất cả các file thì quá trình sẽ đơn giản hơn nhiều

 

[axn125]

Dữ liệu sẽ được điền vào các file "PL01-75902001","PL01-75902001",.....,"PL01-759020037"
Dữ liệu được điền vào tương ứng theo Quí từ cột C đến K
Dữ liệu sẽ được lấy và đưa vào file tổng hợp

Làm như anh Sealand chạy cũng đáp ứng được, nhưng code chạy hơi chậm vì phải chờ duyệt qua tất cả các file báo cáo rồi mới đưa dữ liệu vào file MasterTH

Trong code của anh Sealand có ghi :
FName = ThisWorkbook.Path & "\PL01-" & Sheet1.Cells(i, "B") & ".xls"
--> Vậy nếu file excel có đinh dạng ".xlsx" thì không chạy được.

 

[sealand]

Cảm ơn Sealand rất nhiều, có phần code này mình chưa hiểu lắm. Anh Sealand có thể giải thích thêm một chút được không

Đáng lẽ bạn phải nói không hiểu đoạn nào chứ?
Nói chung, trong file Master đã có sẵn danh sách các file cần chọn rồi, chọn lại làm chi cho mất công. Thậm chí còn chọn nhầm cả file không có trong danh sách. Nếu cần thiết thì thêm đoan Code để bạn khai báo tìm ở thư mục khác thay vì mặc định là thư mục chứa Master.
Nhân thể mình thêm và Rem luôn:

Sub GetData1()
Dim FName As String, FPath As String, eCol As Integer, i, j, Tb(), OldVal(1 To 2) As Boolean
Dim Wb As Workbook, Sh As Worksheet
On Error Resume Next
[COLOR=#008000][I]'Tao mang danh sach cac thoi diem TH tuong ung cac cot tren file chi tiet[/I][/COLOR]
Tb = Array("1: T5/2015", "2: Q3/2015", "3: Q4/2015", "4: Q1/2016", _
"5: Q2/2016", "6: Q3/2016", "7: Q4/2016", "8: Q1/2017", "9: T5/2017")
[I][COLOR=#008000]'Thong bao thu muc mac dinh va thay the neu can[/COLOR][/I]
FPath = InputBox("Folder chua cac file CT duoi day la mac dinh." & Chr(13) & _
"Neu doi Folder khac thi ban thay the vao.", "THONG BAO", ThisWorkbook.Path)
[I][COLOR=#008000]'Bat buoc phai nhap 1 ky nao do[/COLOR][/I]
Do While InStr(1, "1,2,3,4,5,6,7,8,9", eCol) = 0
eCol = InputBox("Nhap so tuong ung tung thoi ky" & Chr(13) & Join(Tb, Chr(13)), "THONG BAO", 1)
Loop
[I][COLOR=#008000]'Luu lai cac thiet lap moi truong cua may de sau khi su ly xong ta tra ve nguyen trang
'Thiet lap moi truong de code chay hieu qua[/COLOR][/I]
OldVal(1) = Application.ScreenUpdating: If OldVal(1) Then Application.ScreenUpdating = False
OldVal(2) = Application.DisplayAlerts: If OldVal(2) Then Application.DisplayAlerts = False
[I][COLOR=#008000]'Xoa BTH[/COLOR][/I]
Sheet1.[C8:Q42].ClearContents
[I][COLOR=#008000]'Giai doan chep[/COLOR][/I]
Do
[I][COLOR=#008000]'Bat dau thi i=8 va sau do moi vong lap tang them 1 dong den het data[/COLOR][/I]
i = IIf(i = 0, 8, i + 1)
[I][COLOR=#008000]'Can cu dong i cot C ta xac dinh duoc ten file can lay du lieu (FullName)[/COLOR][/I]
FName = FPath & "\PL01-" & Sheet1.Cells(i, "B") & ".xls"
[I][COLOR=#008000]'Kiem tra file xac dinh co ton tai khong, neu ton tai thi lam cac buoc sau[/COLOR][/I]
If Dir(FName) <> "" Then
[I][COLOR=#008000]'Mo file do ra[/COLOR][/I]
Set Wb = Workbooks.Open(FName)
'[I][COLOR=#008000]Tim Sheet co ten "Mau 01" va chep du lieu[/COLOR][/I]
Set Sh = Wb.Worksheets("Mau 01")
Sheet1.Cells(i, 3).Resize(, 4) = WorksheetFunction.Transpose(Sh.Cells(8, eCol + 2).Resize(4))
Sheet1.Cells(i, 9).Resize(, 9) = WorksheetFunction.Transpose(Sh.Cells(12, eCol + 2).Resize(9))
Set Sh = Nothing
[I][COLOR=#008000]'Dong tra lai file[/COLOR][/I]
Wb.Close
Set Wb = Nothing
End If
[I][COLOR=#008000]'Tuan tu den het danh sach cot C[/COLOR][/I]
Loop Until Sheet1.Cells(i, "B") = ""
[I][COLOR=#008000]'Tra lai nguyen trang cac thiet lap cho may[/COLOR][/I]
Application.ScreenUpdating = OldVal(1)
Application.DisplayAlerts = OldVal(2)
End Sub

Vậy nếu file excel có đinh dạng ".xlsx" thì không chạy được.

Tôi chỉ dùng 2003 và ví dụ là *.xls, nếu bạn sử dụng khác đi thì phải điều chỉnh cho phù hợp chứ.
Nói chung, đây là cách đơn giản nhất có thể. Nếu thấy chậm thì nên tìm phương án khác. Nhưng cũng mong bạn đừng võ đoán khi chưa Test và so sánh cụ thể.

 

[axn125]

Rất cảm ơn anh Sealand ! tại do mình đã test trên excel ."xlsx" thấy không đọc được nên mới hỏi vậy, có gì mình sẽ tùy biến thêm cho phù hợp
Cảm ơn đã giải thích code, rất rõ ràng và code chạy rất tốt