tổng hợp các file báo cáo thành 1 file tổng (1 người xem)

Liên hệ QC

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

luckyluke2828

Thành viên mới
Tham gia
16/12/08
Bài viết
36
Được thích
3
Kính gửi mọi người, em có câu hỏi như thế này (thiệt ra đã tìm khắp diễn đàn, có những câu tương tự mà áp dụng không được nên mới nhờ lại các cao thủ làm giúp một lần nữa)
- Em có file đặt phụ tùng (tên file VD là mau 1, mau 2 ...). mỗi lần có đặt hàng thì có người sẽ soạn theo mẫu trên và gửi cho em. Nhiệm vụ của em là phải làm một file tổng hợp toàn bộ các báo cáo đó (file Tong hop đính kèm) (có thể có khoảng 50 file mẫu trong một lần tổng hợp).
- Mỗi file đặt phụ tùng có thể đặt 1 hoặc nhiều phụ tùng nên có thể ghi trong 1 hoặc nhiều dòng (từ dòng 9)
- File Tong hop cần tổng hợp đầy đủ thông tin trong từng file mẫu , các dòng liên tiếp nhau và kèm thêm thông tin Date và request number trong cột I và J.
Nhờ mọi người giúp giùm
Để minh hoạ, em có làm gấp các file mau 1, mau 2, Tong hop như đính kèm.
Cảm ơn nhiều nhiều.
 

File đính kèm

Kính gửi mọi người, em có câu hỏi như thế này (thiệt ra đã tìm khắp diễn đàn, có những câu tương tự mà áp dụng không được nên mới nhờ lại các cao thủ làm giúp một lần nữa)
- Em có file đặt phụ tùng (tên file VD là mau 1, mau 2 ...). mỗi lần có đặt hàng thì có người sẽ soạn theo mẫu trên và gửi cho em. Nhiệm vụ của em là phải làm một file tổng hợp toàn bộ các báo cáo đó (file Tong hop đính kèm) (có thể có khoảng 50 file mẫu trong một lần tổng hợp).
- Mỗi file đặt phụ tùng có thể đặt 1 hoặc nhiều phụ tùng nên có thể ghi trong 1 hoặc nhiều dòng (từ dòng 9)
- File Tong hop cần tổng hợp đầy đủ thông tin trong từng file mẫu , các dòng liên tiếp nhau và kèm thêm thông tin Date và request number trong cột I và J.
Nhờ mọi người giúp giùm
Để minh hoạ, em có làm gấp các file mau 1, mau 2, Tong hop như đính kèm.
Cảm ơn nhiều nhiều.
Bạn dùng code này. Put code vào file tông và cho các file vào cùng 1 folder
Mã:
Sub GhepFile()
Dim WB As Workbook, FSO As Object, SourceFolder As Object, sFolder As String
Dim i, j, k As Integer, arr(1 To 1000, 1 To 10), timmm As Double
Dim objExcel As New Excel.Application
Application.ScreenUpdating = False

Application.FileDialog(msoFileDialogFolderPicker).Show
sFolder = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
timmm = Timer
objExcel.Visible = False
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(sFolder)
    For Each FileItem In SourceFolder.Files
        If FileItem.Name <> "Tong hop.xlsx" And Left(FileItem.Name, 1) <> "~" Then
            Set WB = objExcel.Workbooks.Open(FileItem.Path)
            With WB.Sheets(1)
                For i = 9 To .Range("C" & Rows.Count).End(3).Row
                    k = k + 1
                    arr(k, 1) = k
                    arr(k, 9) = .Cells(4, 3)
                    arr(k, 10) = .Cells(5, 3)
                    For j = 2 To 8
                        arr(k, j) = .Cells(i, j)
                    Next
                Next i
            End With
            WB.Close False
        End If
    Next FileItem
    Set objExcel = Nothing
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
    Range("A9").Resize(k, 10) = arr
Application.ScreenUpdating = True
MsgBox (Timer - timmm)
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT

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

Back
Top Bottom