Gộp dữ liệu nhiều file thành một file tổng hợp (3 người xem)

[tailuu_3047]

Chào các anh chị trong 4r
Vấn đề của mình là như thế này
Mình có rất nhiều file CSV ( vài trăm file dạng này ), mỗi file CSV chứa rất nhiều nội dung là doanh thu, lợi nhuận, tài sản, vốn chủ sở hữu…..
Mình muốn tổng hợp thành một file với nhiều sheet, như là sheet doanh thu, sheet lợi nhuận, sheet tài sản…
Trong mỗi file CSV có năm có data, có năm không có data. Các anh chị có thể giúp mình được không ạ
Hơi khó diễn đạt, các bạn có thể down file mình đính kèm để xem nhé. Mình cám ơn và chúc sức khỏe.

 

[tailuu_3047]

Các bác giúp mình với nhé, mình đang cần gấp

 

[tailuu_3047]

Không có bác nào giúp hết sao ?

 

[lamk_kute]

down tới 19 lần mà không ai giúp đc ??? chắc tại bạn diễn đạt chưa dõ dàng

 

[tailuu_3047]

No one help me

 

[longlt08]

Mình đã xem file đính kèm. Đây là dữ liệu xuất từ chương trình Kế toán nào đó ra đúng không bạn. Với các file dạng này bạn nên "chế biến " lại rôi cho tất cả vào một sheet, thiết kế tiêu đề cột cho bảng dữ liệu. Bạn dùng PivotTable để giải quyết việc lọc, tạo báo biểu, tổng hợp số liệu rất nhanh chóng chỉ bằng động tác kéo thả chuột.
Chúc bạn thành công.

 

[tailuu_3047]

Thật ra đây là Báo cáo tài chính thu gọn cho từng doanh nghiệp mà các wed tài chính cung cấp bạn à. Tận gần 700 file, mỗi quý update 1 lần. Mỗi lần mình tổng hợp thủ công là đuối luôn. Mình muốn gom 700 file riêng lẻ thành một file cho dễ quan sát và theo dõi. Các bạn có cách nào nhanh hơn không ?

 

[lamk_kute]

gom 700 file thành 1 ? đoợc không trời! chắc nó thành boom-X mở được đảm bảo đơ máy

 

[lamk_kute]

thôi mỗi quý mới có 1 lần cố gắng lên bạn ơi

 

[Lequocvan]

Bạn xem thử code sau:
Sub CombineWorkbooks()
Dim FilesToOpen
Dim x As Integer
On Error GoTo ErrHandler
Application.ScreenUpdating = False
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Microsoft Excel Files (*.xl*), *.xl*", MultiSelect:=True, Title:="Files to Merge")
'(FileFilter:="Microsoft Excel Files (*.xls), *.xls", MultiSelect:=True, Title:="Files to Merge")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If
x = 1
While x <= UBound(FilesToOpen)
Workbooks.Open FileName:=FilesToOpen(x)
Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
x = x + 1
Wend
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub

 

[tailuu_3047]

Cám ơn bạn giúp đỡ nhé nhưng code này là gôm mí file kia vào chung 1 file tổng hợp. Gôm hết vào các sheet. Ý của mình là lấy dữ liệu từ các file kia rồi phân luồng thẳng vào file tỏng hợp đó bạn.
Ví dụ như lấy hết doanh thu của mí file kia từng năm rồi đưa vào sheet doanh thu tổng hợp ấy.

 

[nmhung49]

Cám ơn bạn giúp đỡ nhé nhưng code này là gôm mí file kia vào chung 1 file tổng hợp. Gôm hết vào các sheet. Ý của mình là lấy dữ liệu từ các file kia rồi phân luồng thẳng vào file tỏng hợp đó bạn.
Ví dụ như lấy hết doanh thu của mí file kia từng năm rồi đưa vào sheet doanh thu tổng hợp ấy.

CÓ vài dữ liệu trong file tổng hợp tôi không biết bạn lấy từ đâu vì mở các file kia lên không khớp bạn chỉ cần làm các sheet trong file tổng hợp đầy đủ dữ liệu muốn lấy từ 1 file trên trang web thôi (lấy từ dòng nào của file nguồn) để biết đường mà giúp tôi có ý tưởng mà nhìn dữ liệu bạn tổng hợp sẵn thấy không đúng nên không giúp được

 

[tailuu_3047]

Nguồn data mình lấy từ đây nhé bạn http://www.cophieu68.vn/export.php ( cột thứ 5 - DL BCTC ). Đây là BCTC riêng lẻ của từng công ty. Có công ty thì quý nào cũng có báo cáo, có công ty thì không. Vì thế mà trong nhiều BCTC của các công ty thiếu dữ liệu một vài quý chứ không phải quý nào cũng có. Mình muổn tổng hợp lại theo từng sheet doanh thu, lợi nhuận, tài sản... theo từng quý và năm từ 2006 đến nay. Phiền bạn coi giúp nhé. Thanks bạn!

 

[nmhung49]

Nguồn data mình lấy từ đây nhé bạn http://www.cophieu68.vn/export.php ( cột thứ 5 - DL BCTC ). Đây là BCTC riêng lẻ của từng công ty. Có công ty thì quý nào cũng có báo cáo, có công ty thì không. Vì thế mà trong nhiều BCTC của các công ty thiếu dữ liệu một vài quý chứ không phải quý nào cũng có. Mình muổn tổng hợp lại theo từng sheet doanh thu, lợi nhuận, tài sản... theo từng quý và năm từ 2006 đến nay. Phiền bạn coi giúp nhé. Thanks bạn!

Bạn không hiểu ý tôi, tôi nhờ bạn làm mẫu kết quả mong muốn vào file Tonghop để tôi biết lấy kết quả cho đúng vì tôi thấy có nhiều dữ liệu bạn làm mẫu sẵn không giống cac file tổng hợp, tôi làm đại xem đúng không nhấn nút load ở sheet Doanh thu rồi tìm tới các file muốn tổng hợp rồi nhập nút open xem kết quả đúng

[GPECODE=vb]
Sub Test()
Dim i As Long, index As Integer, dkynguon
Dim Ky, Kynguon, KQ(1 To 1000, 1 To 100)
Dim fn, j As Long, ma As String, fRowDT As Range
Ky = Sheet2.Range("B1:AT1").Value
fn = Application.GetOpenFilename(MultiSelect:=True)
If Not IsArray(fn) Then Exit Sub
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
For j = 1 To UBound(fn)
ma = Mid(fn(j), InStrRev(fn(j), ".xls") - 3, 3)
With Workbooks.Open(fn(j))
With .ActiveSheet
Set fRowDT = .Range("A:A").Find("KET QUA KINH DOANH")
Kynguon = fRowDT.CurrentRegion.Resize(1).Value
dkynguon = fRowDT.CurrentRegion.Value
For i = 1 To UBound(Ky, 2)
If Application.WorksheetFunction.CountIf(fRowDT.CurrentRegion.Resize(1), Ky(1, i)) > 0 Then
index = WorksheetFunction.Match(Ky(1, i), Kynguon, 0)
KQ(j, i + 1) = dkynguon(4, index)
End If
Next
KQ(j, 1) = UCase(ma)
End With
End With
ActiveWorkbook.Close
Next
With Sheet2.Range("A2:AT1000")
.ClearContents
.Cells(1, 1).Resize(j, 99).Value = KQ
End With
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub


[/GPECODE]

 

[tailuu_3047]

Bạn không hiểu ý tôi, tôi nhờ bạn làm mẫu kết quả mong muốn vào file Tonghop để tôi biết lấy kết quả cho đúng vì tôi thấy có nhiều dữ liệu bạn làm mẫu sẵn không giống cac file tổng hợp, tôi làm đại xem đúng không nhấn nút load ở sheet Doanh thu rồi tìm tới các file muốn tổng hợp rồi nhập nút open xem kết quả đúng

[GPECODE=vb]
Sub Test()
Dim i As Long, index As Integer, dkynguon
Dim Ky, Kynguon, KQ(1 To 1000, 1 To 100)
Dim fn, j As Long, ma As String, fRowDT As Range
Ky = Sheet2.Range("B1:AT1").Value
fn = Application.GetOpenFilename(MultiSelect:=True)
If Not IsArray(fn) Then Exit Sub
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
For j = 1 To UBound(fn)
ma = Mid(fn(j), InStrRev(fn(j), ".xls") - 3, 3)
With Workbooks.Open(fn(j))
With .ActiveSheet
Set fRowDT = .Range("A:A").Find("KET QUA KINH DOANH")
Kynguon = fRowDT.CurrentRegion.Resize(1).Value
dkynguon = fRowDT.CurrentRegion.Value
For i = 1 To UBound(Ky, 2)
If Application.WorksheetFunction.CountIf(fRowDT.CurrentRegion.Resize(1), Ky(1, i)) > 0 Then
index = WorksheetFunction.Match(Ky(1, i), Kynguon, 0)
KQ(j, i + 1) = dkynguon(4, index)
End If
Next
KQ(j, 1) = UCase(ma)
End With
End With
ActiveWorkbook.Close
Next
With Sheet2.Range("A2:AT1000")
.ClearContents
.Cells(1, 1).Resize(j, 99).Value = KQ
End With
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub


[/GPECODE]

Đúng ý của mình rồi bạn, nhưng mà doanh thu ở đây là dòng Tổng doanh thu từ hoạt động kinh doanh nhé bạn chứ không phải là doanh thu thuần. Phiền bạn code lại và có thể làm thêm mí cái sheet lợi nhuận, tài sản, vốn chủ sở hữu, lợi nhuận gộp giúp mình được không ? Mình gửi lại file đính kèm có tổng hợp số liệu như bạn nói trên nhé.
Mình chân thành cám ơn bạn nha!

 

[nmhung49]

Đúng ý của mình rồi bạn, nhưng mà doanh thu ở đây là dòng Tổng doanh thu từ hoạt động kinh doanh nhé bạn chứ không phải là doanh thu thuần. Phiền bạn code lại và có thể làm thêm mí cái sheet lợi nhuận, tài sản, vốn chủ sở hữu, lợi nhuận gộp giúp mình được không ? Mình gửi lại file đính kèm có tổng hợp số liệu như bạn nói trên nhé.
Mình chân thành cám ơn bạn nha!

Sửa lại rồi đó rãnh thì gom lại 1 nút cho 4 sheet không thì cứ để 4 sheet 4 nút cho an toàn

 

[tailuu_3047]

Cám ơn bạn nhiều nhé. Chúc bạn nhiều may mắn và hạnh phúc trong cuộc sống !

 

[tailuu_3047]

Sửa lại rồi đó rãnh thì gom lại 1 nút cho 4 sheet không thì cứ để 4 sheet 4 nút cho an toàn

Cám ơn bạn nhiều nhé. Chúc bạn nhiều may mắn và hạnh phúc trong cuộc sống !
PS : Bạn ơi, bạn gán hết vào một nút luôn được không, vì mỗi lần update nó hơi lâu, mình muốn dồn hết vào một nút rồi update một lần cùng lúc rồi làm việc khác trong khi chờ đợi . Sorry vì mình không biết tý gì về VBA nên phiền bạn thêm tý xíu nữa nhé

 

[toantinhte87]

Mình muốn tổng hợp tính tổng vào file tổng của công ty từ các file các đơn vị gửi lên. (file tổng và file con của đơn vị cùng mẫu)
Bình thường tôi mở từng file một rồi dùng lệnh = rồi tích vào từng ô 1 của từng file nhưng cách này rất mật thời gian. Ai có cách khác bằng VBA giúp tối với.
Tôi cần: Ô A2 của file Công ty = ô A2 đơn vị 1 + A2 đơn vị 2 + ........

 

[Thuyanhanoi]

Mình muốn tổng hợp tính tổng vào file tổng của công ty từ các file các đơn vị gửi lên. (file tổng và file con của đơn vị cùng mẫu)
Bình thường tôi mở từng file một rồi dùng lệnh = rồi tích vào từng ô 1 của từng file nhưng cách này rất mật thời gian. Ai có cách khác bằng VBA giúp tối với.
Tôi cần: Ô A2 của file Công ty = ô A2 đơn vị 1 + A2 đơn vị 2 + ........

- Trong khi đợi các câu trả lời hay hơn bạn dùng tam cái này xem có được không?
- Chạy code và chọn các file, lấy dữ liệu về rồi tính tổng

Sub Tong_hop_tinh_tong()Application.ScreenUpdating = False
On Error GoTo thoat:
Dim data, kq(1 To 65000, 1 To 5), stfile As Variant, I, J, K As Long, st As String, flag As Boolean, WB As Workbook
 With Application.FileDialog(msoFileDialogOpen)
    .AllowMultiSelect = True
    .Show
    For Each stfile In .SelectedItems
        Set WB = Workbooks.Open(stfile)
        With WB.Sheets("Sheet1")
            data = .Range(.[A3], .[A65000].End(xlUp)).Resize(, 5).Value
        End With
        For I = 1 To UBound(data)
            K = K + 1
            kq(K, 1) = data(I, 1)
            For J = 2 To 5
                kq(K, J) = data(I, J)
            Next J
        Next I
        WB.Close False
    Next
End With
If K Then
With Sheets("Tong_hop")
    .[A3:E65000].ClearContents
    .[A3].Resize(K, 5) = kq
    .[A3].Resize(K, 5).Borders.LineStyle = xlNone
    .[A3].Resize(K, 5).Borders.LineStyle = xlContinuous
    .[A3].Resize(K, 5).Borders(xlInsideHorizontal).Weight = xlHairline
    .Range("A3").End(xlDown).Offset(1, 0) = "=SUM(R[-" & K & "]C:R[-1]C)"
    .Range("B3").End(xlDown).Offset(1, 0) = "=SUM(R[-" & K & "]C:R[-1]C)"
    .Range("C3").End(xlDown).Offset(1, 0) = "=SUM(R[-" & K & "]C:R[-1]C)"
    .Range("D3").End(xlDown).Offset(1, 0) = "=SUM(R[-" & K & "]C:R[-1]C)"
    .Range("E3").End(xlDown).Offset(1, 0) = "=SUM(R[-" & K & "]C:R[-1]C)"
End With
End If
thoat:
If Err Then MsgBox "co loi xay ra"
Application.ScreenUpdating = True
End Sub