Tổng hợp dữ liệu từ nhiều file excel (4 người xem)

Liên hệ QC

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

hoaian606

Thành viên mới
Tham gia
14/9/09
Bài viết
5
Được thích
0
Tôi có một Folder chứa 04 file dữ liệu và nột file tổng hợp.
Nhờ quý cao thủ giúp :
- Làm thế nào để dự liệu ở dòng thứ 2 của bảng tính XLS từ các file DU LIEU 1, DU LIEU 2, DU LIEU 3, DU LIEU 4 tự điền vào File DU LIEU TONG HOP theo đúng thứ tự từ dòng 1 đến dòng 4.
Nhờ các huynh nghiên cứu File đính kèm và hướng dẫn mình cách làm.
Xin chân thành cám ơn.
 

File đính kèm

Bạn xem có đúng ý của bạn không nhé.
 

File đính kèm

Ôke. Đúng ý mình rồi đó bạn. Cám ơn bạn rất nhiều.
Nếu có điều kiện thời gian, xin bạn hướng dẫn mình cách làm, để mình nghiên cứu thêm và vận dụng cho các biểu tương tự.
Chân thành cám ơn.
 
Bài này nhanh nhất là bạn dùng Data/Consolidate
Ở file tổng hợp, bạn vào Data/Consolidate, ở mục Reference... bạn chọn 4 vùng dữ liệu ở 4 file (nhớ là phải chọn cả dòng tiêu đề), mỗi lần chọn bạn nhấn Add. bạn tick vào phần Top row và Left column sau đó nhấn OK là xong.
 
Mình có 1 vấn đề là tổng hợp từ nhiều file vào một file nhưng với số dòng dữ liệu khác nhau thì phải làm sao?
Ví dụ:
- Trong bảng tổng hợp có 3 đơn vị, số cột như nhau ở các file dữ liệu.
- Bây giờ muốn gộp chung cả 3 file dữ liệu vào một file (Giống như file tong hop vi du.xls)

Mong các bạn, các anh chị giúp đỡ. Cám ơn!
 

File đính kèm

chép code vào tổng hợp thử chơi

Mã:
Public Sub hello()
Dim vFile, filename, fso As Object, fullpath As String, lr As Long, curRow As Long
Set fso = CreateObject("scripting.filesystemobject")
vFile = Application.GetOpenFilename("hello (*.xls*), *.xls*", , , , True)
If TypeName(vFile) = "Variant()" Then
    With Sheet1
        curRow = 5
        .Range("A5").Resize(10000, 7).Clear
        For Each filename In vFile
            fullpath = "'" & fso.GetParentFolderName(filename) & _
            "\[" & fso.GetFileName(filename) & "]Sheet1'!"
            .[Z1] = "=IFERROR(LOOKUP(2,1/(" & fullpath & "A1:A10000<>""""),ROW(1:10000)),0)"
            lr = .[Z1]
            If lr > 4 Then
                .Range("B" & curRow).Resize(lr - 4, 6).FormulaArray = "=if(" & fullpath & _
                "B5:G" & lr & "="""",""""," & fullpath & "B5:G" & lr & ")"
                .Range("B" & curRow).Resize(lr - 4, 6).Value = .Range("B" & curRow).Resize(lr - 4, 6).Value
                .Range("A" & curRow).Resize(lr - 4).Merge
                .Range("A" & curRow).Resize(lr - 4).VerticalAlignment = xlCenter
                .Range("A" & curRow).Resize(lr - 4).HorizontalAlignment = xlCenter
                .Range("A" & curRow).Value = "=" & fullpath & "B1"
                .Range("A" & curRow) = Mid(.Range("A" & curRow), InStr(.Range("A" & curRow), ":") + 1)
                curRow = curRow + lr - 4
            End If
        Next
        If curRow > 5 Then .Range("A5:G" & curRow - 1).Borders.LineStyle = xlContinuous
        .[Z1].ClearContents
    End With
End If
End Sub
 
chép code vào tổng hợp thử chơi

Mã:
Public Sub hello()
Dim vFile, filename, fso As Object, fullpath As String, lr As Long, curRow As Long
Set fso = CreateObject("scripting.filesystemobject")
vFile = Application.GetOpenFilename("hello (*.xls*), *.xls*", , , , True)
If TypeName(vFile) = "Variant()" Then
    With Sheet1
        curRow = 5
        .Range("A5").Resize(10000, 7).Clear
        For Each filename In vFile
            fullpath = "'" & fso.GetParentFolderName(filename) & _
            "\[" & fso.GetFileName(filename) & "]Sheet1'!"
            .[Z1] = "=IFERROR(LOOKUP(2,1/(" & fullpath & "A1:A10000<>""""),ROW(1:10000)),0)"
            lr = .[Z1]
            If lr > 4 Then
                .Range("B" & curRow).Resize(lr - 4, 6).FormulaArray = "=if(" & fullpath & _
                "B5:G" & lr & "="""",""""," & fullpath & "B5:G" & lr & ")"
                .Range("B" & curRow).Resize(lr - 4, 6).Value = .Range("B" & curRow).Resize(lr - 4, 6).Value
                .Range("A" & curRow).Resize(lr - 4).Merge
                .Range("A" & curRow).Resize(lr - 4).VerticalAlignment = xlCenter
                .Range("A" & curRow).Resize(lr - 4).HorizontalAlignment = xlCenter
                .Range("A" & curRow).Value = "=" & fullpath & "B1"
                .Range("A" & curRow) = Mid(.Range("A" & curRow), InStr(.Range("A" & curRow), ":") + 1)
                curRow = curRow + lr - 4
            End If
        Next
        If curRow > 5 Then .Range("A5:G" & curRow - 1).Borders.LineStyle = xlContinuous
        .[Z1].ClearContents
    End With
End If
End Sub
Bạn ơi. Nếu mình muốn lấy những vật tư có cùng tên từ 4 file thì thế nào bạn?
 
nhờ các bạn giúp đỡ tổng hợp số liệu từ nhiều file vào file tổng hợp, số liệu cột phát sinh và mã dịch vụ
 

File đính kèm

Lần chỉnh sửa cuối:
thêm đường dẫn vào cột A (path của file nguồn) thì làm thế nào bạn
Bài đã được tự động gộp:

chép code vào tổng hợp thử chơi

Mã:
Public Sub hello()
Dim vFile, filename, fso As Object, fullpath As String, lr As Long, curRow As Long
Set fso = CreateObject("scripting.filesystemobject")
vFile = Application.GetOpenFilename("hello (*.xls*), *.xls*", , , , True)
If TypeName(vFile) = "Variant()" Then
    With Sheet1
        curRow = 5
        .Range("A5").Resize(10000, 7).Clear
        For Each filename In vFile
            fullpath = "'" & fso.GetParentFolderName(filename) & _
            "\[" & fso.GetFileName(filename) & "]Sheet1'!"
            .[Z1] = "=IFERROR(LOOKUP(2,1/(" & fullpath & "A1:A10000<>""""),ROW(1:10000)),0)"
            lr = .[Z1]
            If lr > 4 Then
                .Range("B" & curRow).Resize(lr - 4, 6).FormulaArray = "=if(" & fullpath & _
                "B5:G" & lr & "="""",""""," & fullpath & "B5:G" & lr & ")"
                .Range("B" & curRow).Resize(lr - 4, 6).Value = .Range("B" & curRow).Resize(lr - 4, 6).Value
                .Range("A" & curRow).Resize(lr - 4).Merge
                .Range("A" & curRow).Resize(lr - 4).VerticalAlignment = xlCenter
                .Range("A" & curRow).Resize(lr - 4).HorizontalAlignment = xlCenter
                .Range("A" & curRow).Value = "=" & fullpath & "B1"
                .Range("A" & curRow) = Mid(.Range("A" & curRow), InStr(.Range("A" & curRow), ":") + 1)
                curRow = curRow + lr - 4
            End If
        Next
        If curRow > 5 Then .Range("A5:G" & curRow - 1).Borders.LineStyle = xlContinuous
        .[Z1].ClearContents
    End With
End If
End Sub

thêm đường dẫn vào cột A (path của file nguồn) thì làm thế nào bạn
 
Web KT

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

Back
Top Bottom