Tổng hợp dữ liệu từ nhiều file

[ALOAN]

Hàng tháng bộ phân em nhận báo cáo tồn kho từ mọi nơi đưa về (Xưởng, kho, kệ)
Sau đó phải tổng hợp từ nhiều sheet chi tiết thành 1 sheet tổng hợp
Trong sheet "TongHop" sẻ bao gồm : Mặt hàng(Item), Số lượng tồn (Total), Vi Trí Kiem, Nơi và người kiểm
Với Mặt hàng được tổng hợp từ tất cả các sheet
Số lượng là cột cuối cùng
Vi Tri Kiem là tên sheet
Nơi và người kiểm là tên file excel
1 item có thể tồn tại trong nhiều sheet nhưng không cần phải sum số lượng tồn kho lại
Mổi tháng số sheet báo cáo có thể nhiều hơn có, thể ít hơn
Mong mọi người giúp em tạo 1 Macro để tạo ra sheet "Tong Hop" nhanh mà không phải làm động tác copy and paste

 

[boong]

File đổi định dạnh như lời hứa đây! Chúc bạn thành công.

 

[ALOAN]

Tuyệt quá! Đúng là ngoài sức tưởng tượng của em.
Cảm ơn tất cả mọi người nhiều!
Nhất là Anh ThuNghi!
Hi vọng tiếp tục nhận được sự hổ trợ của mọi người cho topic này.
To: Anh ThuNghi!
Khi nào nghĩ được code hay hơn, anh nhớ post lên cho e học hỏi với nha!

 

[boong]

Khoang khen đã vẫn chưa xong đâu! Cái của em chạy được nhưng có phát hiện nó nạp luôn thằng KIEMTONKHO(aha).xls vào file EXE luôn rồi không thể nạp dữ liệu trên file mới được. Mong ai biết được cách viết VB6 thì chỉ thêm code nạp dữ liệu từ ngoài vào vậy! Chứ nó không chịu nạp dữ liệu mới vào rồi! Nên "Bí"...

 

[ALOAN]

Em lại có rắc rối nữa rồi.Híc
Dựa vào Hướng dẫn của A ThuNghi và Anh nvsonE có chút thay đổi về code.
Mục đích là để thoã mãn các điều sau:
1) Code này được viết trong 1 workbook nhất định
2)Code chạy sẽ open đường dẫn và người use chọn các workbook để copy (số workbook để copy là ko giới hạn).
3) Dữ liệu được copy sang 1 Workbook khác (ko phải là workbook chứa code)
Nhưng khi code chạy thì vướng mắc các vấn đề sau:
1) Khi chọn từ 2 workbook trở lên, code chỉ copy được 1 workbook thôi
2)Dữ liệu được copy vào workbook chứa code (điều ko mong đợi.Híc)
3)Khi copy vào workbook chứa code, thì câu lệnh "Range"A156000").clearcontens" ko thấy có tác dụng.
Mong mọi người nhín chút thời gian giúp em với.

Option Explicit
Public Sub TaoShTongHop2()
Dim i As Integer, eR As Integer, fR As Integer, iR As Integer, eC As Integer, rgnB As Range
Dim shName As String, wName As String
Dim NumSht As Integer
Dim SaveDriveDir As String, mypath As String, rng1 As String, rng2 As String
Dim Fname As Variant, n As Byte
Dim SourceWb As Workbook, TgtWb As Workbook
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
SaveDriveDir = CurDir
mypath = "D:\"
ChDrive mypath
ChDir mypath
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=SaveDriveDir & "Filesaveas", Password:="", writerespassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Fname = Application.GetOpenFilename(filefilter:="excel files(*.xls),*.xls", MultiSelect:=True)
If IsArray(Fname) Then
Set SourceWb = ActiveWorkbook
For n = LBound(Fname) To UBound(Fname)
Set TgtWb = Workbooks.Open(Fname(n))
TgtWb.Activate
wName = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)
NumSht = Sheets.Count
For i = 1 To NumSht
SourceWb.Activate
fR = Sheet1.Range("a65000").End(xlUp).Row + 1 'dong cuoi cua sh TongHop
TgtWb.Activate
shName = Sheets(i).Name
If shName <> "BC ONG" Then
If Sheets(i).UsedRange.Rows.Count > 1 Then
Sheets(i).Select
Range("a1").Select
Cells.Find(What:="stt", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
iR = ActiveCell.Row + 2 'Dong dau sheet i co dl
Cells.Find(What:="Total", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
eC = ActiveCell.Column 'cot co total
eR = Range("B65000").End(xlUp).Row 'Dong cuoi cua sh i
'eR - iR : so dong chua dl
SourceWb.Activate
With Sheet1
.Range("A" & fR & ":A" & eR - iR + fR).Value = TgtWb.Sheets(i).Range("B" & iR & ":B" & eR).Value
rng1 = Cells(iR, eC).Address
rng2 = Cells(eR, eC).Address
.Range("B" & fR & ":B" & eR - iR + fR).Value = TgtWb.Sheets(i).Range(rng1, rng2).Value 'Lay gia tri
.Range("C" & fR & ":C" & eR - iR + fR).Value = shName
.Range("D" & fR & "" & eR - iR + fR).Value = wName 'Lay ten file
End With
End If
End If
Next i
TgtWb.Close False
Next n
End If
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub

Vấn đề nay rất quan trọng với em. Mong các thành viên nhà mình giúp em với.Híc

 

[ThuNghi]

Em lại có rắc rối nữa rồi.Híc
Dựa vào Hướng dẫn của A ThuNghi và Anh nvsonE có chút thay đổi về code.
Mục đích là để thoã mãn các điều sau:
1) Code này được viết trong 1 workbook nhất định
2)Code chạy sẽ open đường dẫn và người use chọn các workbook để copy (số workbook để copy là ko giới hạn).
3) Dữ liệu được copy sang 1 Workbook khác (ko phải là workbook chứa code)
Nhưng khi code chạy thì vướng mắc các vấn đề sau:
1) Khi chọn từ 2 workbook trở lên, code chỉ copy được 1 workbook thôi
2)Dữ liệu được copy vào workbook chứa code (điều ko mong đợi.Híc)
3)Khi copy vào workbook chứa code, thì câu lệnh "Range"A156000").clearcontens" ko thấy có tác dụng.
Mong mọi người nhín chút thời gian giúp em với.


Vấn đề nay rất quan trọng với em. Mong các thành viên nhà mình giúp em với.Híc

Cái này hơi cao với tôi rồi. Chắc phải nhờ NVSon (sư phụ của tôi đó) help quá. Cám ơn Anh Sơn nhé!

 

[voda]

Bạn chỉnh code lại như sau:

Option Explicit
Public Sub TaoShTongHop2()
Dim i As Integer, eR As Integer, fR As Integer, iR As Integer, eC As Integer, rgnB As Range
Dim shName As String, wName As String
Dim NumSht As Integer
Dim SaveDriveDir As String, mypath As String, rng1 As String, rng2 As String
Dim Fname As Variant, n As Byte
Dim SourceWb As Workbook, TgtWb As Workbook
With Application
       .DisplayAlerts = False
       .ScreenUpdating = False
End With
SaveDriveDir = CurDir
mypath = "D:\"
ChDrive mypath
ChDir mypath
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=SaveDriveDir & "Filesaveas", Password:="", writerespassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Fname = Application.GetOpenFilename(filefilter:="excel files(*.xls),*.xls", MultiSelect:=True)
If IsArray(Fname) Then
       Set SourceWb = ActiveWorkbook
       For n = LBound(Fname) To UBound(Fname)
       Set TgtWb = Workbooks.Open(Fname(n))
       TgtWb.Activate
       wName = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)
       NumSht = Sheets.Count
          For i = 1 To NumSht
          SourceWb.Activate
          [I]fR = ActiveSheet.Range("a65000").End(xlUp).Row + 1 [/I]'dong cuoi cua sh TongHop
          TgtWb.Activate
          shName = Sheets(i).Name
               If shName <> "BC ONG" Then
                  If Sheets(i).UsedRange.Rows.Count > 1 Then
                     Sheets(i).Select
                     Range("a1").Select
                     Cells.Find(What:="stt", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
            iR = ActiveCell.Row + 2 'Dong dau sheet i co dl
            Cells.Find(What:="Total", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
                     eC = ActiveCell.Column 'cot co total
                     eR = Range("B65000").End(xlUp).Row 'Dong cuoi cua sh i
                'eR - iR : so dong chua dl
                      SourceWb.Activate
                         [I]With ActiveSheet[/I]
                           .Range("A" & fR & ":A" & eR - iR + fR).Value = TgtWb.Sheets(i).Range("B" & iR & ":B" & eR).Value
                           rng1 = Cells(iR, eC).Address
                            rng2 = Cells(eR, eC).Address
                           .Range("B" & fR & ":B" & eR - iR + fR).Value = TgtWb.Sheets(i).Range(rng1, rng2).Value 'Lay gia tri
                           .Range("C" & fR & ":C" & eR - iR + fR).Value = shName
                           .Range("D" & fR & ":D" & eR - iR + fR).Value = wName 'Lay ten file
                         End With
                     End If
                  End If
               Next i
               TgtWb.Close False
            Next n
         End If
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub

 

[ALOAN]

Cảm ơn Bác Voda!
Bác cho E hỏi thêm chút. Tại sao khi em chỉ rỏ là sheet1 mà code lại sai, trong khi Bác dùng Activesheet lại đúng ko?Em thấy khó hiểu quá.

 

[voda]

-Khi làm việc với nhiều workbooks, ví dụ như từ 1 wkbook chứa code chạy, ta mở nhiều wbook khác, Ex quy định tên sheet mặc định như: sheet1, sheet2... là sheet của wbook chứa code. Còn các tên khác như: Sheets("TONGHOP"); Sheets(1), Sheets(i) là sheet của wbook đang Active. Nếu khi viết code ta không chú ý điều này, code sẽ chạy sai hoặc báo lỗi.

 

[ALOAN]

Đúng là 1 thông tin thú vị. Cảm ơn Bác nhiều!
Tuy là dữ liệu được copy sang book khác. Nhưng chạy code vẫn báo lỗi chổ được tô đỏ.

TgtWb.Activate
shName = Sheets(i).Name
If shName <> "BC ONG" Then
If Sheets(i).UsedRange.Rows.Count > 1 Then
Sheets(i).Select

Mọi người xem giúp em với.

 

[dieuthuy80]

Các bác ơi giúp em với , em cũng có muốn tổng hợp dữ liệu của 12 tháng vào một sheet tổng hợp vậy phải làm thế nào ạ, em mới bập bệ làm máy lên các bác giúp em với.

 

[dmtdmtbb]

Các bác ơi giúp em với , em cũng có muốn tổng hợp dữ liệu của 12 tháng vào một sheet tổng hợp vậy phải làm thế nào ạ, em mới bập bệ làm máy lên các bác giúp em với.

Bạn có thể post bài ở topic mới và nên có file ví dụ kèm chú thích rõ rang, sẽ có câu trả lời ngay.

 

[ThuNghi]

Đúng là 1 thông tin thú vị. Cảm ơn Bác nhiều!
Tuy là dữ liệu được copy sang book khác. Nhưng chạy code vẫn báo lỗi chổ được tô đỏ.

Mọi người xem giúp em với.

Code của Thầy Voda đúng rồi. Nếu em có thể diễn giải code trên OK thì em đã nắm bắt. Lý do mà sheets(i) báo lỗi là do file kiemketonkho có virus macro, nên sẽ có những sheet ẩn có tên là 000000000 mà bạn không tìm thấy.
Dùng excel 2007, mở file kiemketonkho ra.
Breaklink các file link
Nhấn Ctr F3, delete tòan bộ name, save lại
Chạy code trên.

 

[ALOAN]

Code của Thầy Voda đúng rồi. Nếu em có thể diễn giải code trên OK thì em đã nắm bắt. Lý do mà sheets(i) báo lỗi là do file kiemketonkho có virus macro, nên sẽ có những sheet ẩn có tên là 000000000 mà bạn không tìm thấy.
Dùng excel 2007, mở file kiemketonkho ra.
Breaklink các file link
Nhấn Ctr F3, delete tòan bộ name, save lại
Chạy code trên.

Em đã làm như chỉ dẫn, các name cũng được xoá hết, nhưng vẫn thấy các sheet có tên 000000000.
Em phải làm sao để xoá các sheet này.
Vì khi chạy code vẫn báo lổi.

 

[ThuNghi]

Em đã làm như chỉ dẫn, các name cũng được xoá hết, nhưng vẫn thấy các sheet có tên 000000000.
Em phải làm sao để xoá các sheet này.
Vì khi chạy code vẫn báo lổi.

Cài ASAP ultilities (có trên GPE) vào mục show all sheet. Sau đó xóa bỏ.