Tổng hợp dữ liệu từ nhiều File vào 1 file Tong.xls (1 người xem)

Hoacomay96 · 18/3/08

Xin chào các tiền bối. Tôi muốn copy vùng dữ liệu ở sheet1 từ các files có tên là TXT_1, TXT_2, TXT3 ,....DN_500 trong cùng thư mục và có cấu trúc dữ liệu như nhau dán vào 1 file mới tên là "Tong.xls ". Vùng dữ liệu được dán từ file 1 đến hết, và tự động đếm số dòng trong file tổng. Tôi có file dữ liệu và code đính kèm, mong các tiền bối sửa giúp. Xin cám ơn rất nhiều. -+*/

nvson · 19/3/08

- Bạn để các files có tên là TXT_1, TXT_2, TXT3 ,....DN_500 vào cùng 1 thư mục (*.xls).
- Trong File Tong.xls bạn thêm đoạn Code sau:

Mã:

Option Explicit
Sub Example5()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim n As Long, rNum As Long
 
Dim MyPath As String
Dim SaveDriveDir As String
Dim FName As Variant
 
SaveDriveDir = CurDir
MyPath = "D:\"
ChDrive MyPath
ChDir MyPath
 
FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", MultiSelect:=True)
If IsArray(FName) Then
    Application.ScreenUpdating = False
    
    Set basebook = ActiveWorkbook
    rNum = 1
            
    For n = LBound(FName) To UBound(FName)
        Set mybook = Workbooks.Open(FName(n))
        
        'Day chinh la vung ma ban can copy (Vung [B][COLOR=red]A10:E20[/COLOR][/B] trong sheet co ten la Sheet1
        Set sourceRange = mybook.Worksheets("Sheet1").[COLOR=red][B]Range("A10:E20")[/B][/COLOR]
        rNum = (n - 1) * sourceRange.Rows.Count + 1
                
        'Xac dinh o de copy
        Set destrange = basebook.Worksheets("Sheet1").Cells(rNum, "A")
                   
        With sourceRange
            Set destrange = basebook.Worksheets("Sheet1").Cells(rNum, "A").Resize(.Rows.Count, .Columns.Count)
        End With
        destrange.Value = sourceRange.Value
        
        'Dong file
        mybook.Close False
        
    Next n
End If
'Tra ve mac dinh truoc khi mo
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

Chạy marco trên, chọn tất cả các files chứa dữ liệu, rồi nhấn Open...

Hoacomay96 · 19/3/08

Cám ơn bác NVSON nhiều.Nhưng em muốn chạy code đó trên 1 file khác, nó sẽ tự tạo ra file Tong.xls và copy dữ liệu từ các file TXT_.xls trong cùng thư mục vào file đó.trước khi tổng hợp thì tìm xem trong thư mục D:\TXT\ đã có file Tong.xls chưa ? nếu có thì xóa và tạo file mới.Nhờ bác viết giùm em.

nvson · 19/3/08

Hoacomay96 đã viết:
Cám ơn bác NVSON nhiều.Nhưng em muốn chạy code đó trên 1 file khác, nó sẽ tự tạo ra file Tong.xls và copy dữ liệu từ các file TXT_.xls trong cùng thư mục vào file đó.trước khi tổng hợp thì tìm xem trong thư mục D:\TXT\ đã có file Tong.xls chưa ? nếu có thì xóa và tạo file mới.Nhờ bác viết giùm em.

Bạn dùng đoạn code sau:

Mã:

Option Explicit
Sub Example5()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim n As Long, rNum As Long
 
Dim MyPath As String
Dim SaveDriveDir As String
Dim FName As Variant
 
SaveDriveDir = CurDir
MyPath = "D:\TXT\"
ChDrive MyPath
ChDir MyPath
 
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=MyPath & "tong.xls", FileFormat:=xlExcel8, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
 
FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", MultiSelect:=True)
If IsArray(FName) Then
    Set basebook = ActiveWorkbook
    rNum = 1
            
    For n = LBound(FName) To UBound(FName)
        Set mybook = Workbooks.Open(FName(n))
        
        'Day chinh la vung ma ban can copy (Vung A10:E20 trong sheet co ten la Sheet1
        Set sourceRange = mybook.Worksheets("Sheet1").Range("[COLOR=red][B]A10:E20[/B][/COLOR]")
        rNum = (n - 1) * sourceRange.Rows.Count + 1
                
        'Xac dinh o de copy
        Set destrange = basebook.Worksheets("Sheet1").Cells(rNum, "A")
                   
        With sourceRange
            Set destrange = basebook.Worksheets("Sheet1").Cells(rNum, "A").Resize(.Rows.Count, .Columns.Count)
        End With
        destrange.Value = sourceRange.Value
        
        'Dong file
        mybook.Close False
        
    Next n
End If
'Tra ve mac dinh truoc khi mo
ChDrive SaveDriveDir
ChDir SaveDriveDir
With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
End With
End Sub

ALOAN · 19/3/08

Anh nvson cho em hỏi chút xíu!

Set destrange = basebook.Worksheets("Sheet1").Cells(rNum, "A").Resize(.Rows.Count, .Columns.Count)

Đoạn code trên có nghĩa gì vậy.

Hoacomay96 · 19/3/08

Tuyệt quá cám ơn sư phụ NVSON đã tạo cho em file mới.Em muốn hỏi thêm sư phụ là: trước khi tạo file Tong.xls em muốn tìm kiếm trên địa chỉ D:\TXT\Tong.xls có chưa, nếu có thì xóa file Tong.xls đi và tạo file mới.Và các files TXT_.xls dữ liệu của em có số hàng dữ liệu trong mỗi file thay đổi thì viết thế nào.

nvson · 19/3/08

Mã:

Set destrange = basebook.Worksheets("Sheet1").Cells(rNum, "A").Resize(.Rows.Count, .Columns.Count)

Mục đích của đoạn code trên là thay đổi kích thước của vùng destRange, tính từ cột A dòng rNum. Thay đổi kích thước vùng destRange bằng với kích thước vùng sourceRange.

Hoacomay96 · 19/3/08

anh cho em hỏi với vùng dữ liệu không phải là A10:E20 mà thay đổi số dòng theo từng file vdụ như File1 từ A1:E100 file2 là A1:E150 ... thì sửa code thế nào ạ ?

nvson · 19/3/08

Hoacomay96 đã viết:
....Em muốn hỏi thêm sư phụ là: trước khi tạo file Tong.xls em muốn tìm kiếm trên địa chỉ D:\TXT\Tong.xls có chưa, nếu có thì xóa file Tong.xls đi và tạo file mới.

Mã:

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=MyPath & "tong.xls", FileFormat:=xlExcel8, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False

Đoạn Code trên tuy không kiểm tra file tong.xls đã tồn tại hay chưa nhưng do yêu cầu của bạn là tạo 1 file tong.xls mới hoàn toàn nên mình sử dụng luôn tính năng tạo mới 1 Workbook và ghi thành file tong.xls. Như vậy nếu file tong.xls đã có thì cũng bị ghi đè.

Và các files TXT_.xls dữ liệu của em có số hàng dữ liệu trong mỗi file thay đổi thì viết thế nào.

Bạn thử dùng đoạn code sau:

Mã:

Option Explicit
Sub Example5()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim n As Long, rNum As Long
 
Dim MyPath As String
Dim SaveDriveDir As String
Dim FName As Variant
 
SaveDriveDir = CurDir
MyPath = "D:\TXT\"
ChDrive MyPath
ChDir MyPath
 
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=MyPath & "tong.xls", FileFormat:=xlExcel8, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
 
FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", MultiSelect:=True)
If IsArray(FName) Then
    Set basebook = ActiveWorkbook
    rNum = 1
 
    For n = LBound(FName) To UBound(FName)
        Set mybook = Workbooks.Open(FName(n))
 
        Set sourceRange = mybook.Worksheets("Sheet1").[B][COLOR=red]UsedRange[/COLOR][/B][COLOR=red]
[/COLOR]       rNum = (n - 1) * sourceRange.Rows.Count + 1
 
        'Xac dinh o de copy
        Set destrange = basebook.Worksheets("Sheet1").Cells(rNum, "A")
 
        With sourceRange
            Set destrange = basebook.Worksheets("Sheet1").Cells(rNum, "A").Resize(.Rows.Count, .Columns.Count)
        End With
        destrange.Value = sourceRange.Value
 
        'Dong file
        mybook.Close False
 
    Next n
End If
'Tra ve mac dinh truoc khi mo
ChDrive SaveDriveDir
ChDir SaveDriveDir
With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
End With
End Sub

Hoacomay96 · 19/3/08

anh đã dùng thuộc tính .USERange để chọn vùng dữ liệu thật hay mà em không biết.a bảo e cách xoá 1 file thì làm thế làm ạ ? em chưa rành VBA lắm nhờ anh giúp đỡ.

nvson · 19/3/08

Hoacomay96 đã viết:
anh đã dùng thuộc tính .USERange để chọn vùng dữ liệu thật hay mà em không biết.a bảo e cách xoá 1 file thì làm thế làm ạ ? em chưa rành VBA lắm nhờ anh giúp đỡ.

Muốn xóa files trong VBA bạn dùng hàm Kill
Ví dụ:

Mã:

Public Sub Xoa()
[B][COLOR=red]Kill "D:\GiaiPT.xls"
[/COLOR][/B]End Sub

tedaynui · 19/3/08

thaitranpmud đã viết:
Mình định dang cột theo kiểu custom (dd/mm/yyyy). Sau khi nhập liệu xong mình định dạng theo kiểu "Text", nó tự động chuyển thành số . mình không biết sửa như thế nào . nhập lại dữ liệu thì nhiều quá
Mình muốn viết trên macro của Excel thay đổi kiểu "custom" sang kiểu "text" và dữ liệu ngày tháng vẫn giữ nguyên không chuyển thành số . Bạn nào có cách nào chỉ mình với

Bạn lưu ý post bài phù hợp với chủ đề của topic.
+ Không cần dùng VBA đâu, bạn có thể dùng công thức sau TEXT(A1,"dd/mm/yyyy") sau đó copy xuống, copy và Past Value trở lại.

+ Nếu dùng VBA thì cũng đơn giản nhưng mình nghĩ không cần thiết.

TDN

ALOAN · 20/3/08

Em thấy đoạn code này ko ổn lắm.

rNum = (n - 1) * sourceRange.Rows.Count + 1

Anh kiểm tra lại dùm em nha

Giả sử n=2,
Fname(1) có 15 dòng
Fname(2) có 20 dòng
Em dang hiểu rNum là dòng để copy
Trong vòng lặp thứ 2 thì : rNum = (2-1)*20+1=21
Theo em nghỉ sau khi copy 15 dòng của Fname(1) thì Fname(2) sẽ được copy và dán từ dòng 16<>21
Không biết em hiểu như trên có đúng không!
Mong Anh góp ý thêm.

Hoacomay96 · 20/3/08

Em đã chạy thử code của anh nhưng kết quả chỉ copy được dữ liệu ở file 1 là đúng còn file 2 trở đi thì dữ liệu dán bị cắt mất hoặc bị cách dòng. Vị trí dán nằm không đúng. ví dụ dữ liệu ở file 2 được dán vào vị trí = số dòng của file 2 chứ không phải số dòng của file 1 anh ạ. Nhờ anh sửa lại giúp em.

Chào anh NVSON. em đã chạy code của anh nhưng dữ liệu được copy từ File 2 trở đi dán vào file Tong.xls không đúng, nó bị cắt mất dữ liệu vì vị trí dán của file2 = số dòng của file 2 nên bị đè mất.Anh lại giúp em lần nữa đi.Mong tin anh !

nvson · 24/3/08

Mình đã sửa lại đây:

Mã:

Option Explicit
'
Sub Example5()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destRange As Range
Dim n As Long, rNum As Long
 
Dim MyPath As String
Dim SaveDriveDir As String
Dim FName As Variant
 
SaveDriveDir = CurDir
MyPath = "D:\TXT\"
ChDrive MyPath
ChDir MyPath
 
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=MyPath & "tong.xls", FileFormat:=xlExcel8, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
 
FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", MultiSelect:=True)
If IsArray(FName) Then
    Set basebook = ActiveWorkbook
    rNum = 1
 
    For n = LBound(FName) To UBound(FName)
        Set mybook = Workbooks.Open(FName(n))
 
        Set sourceRange = mybook.Worksheets("Sheet1").UsedRange
       
        'Xac dinh o de copy
        Set destRange = basebook.Worksheets("Sheet1").Cells(rNum, "A")
 
        With sourceRange
            Set destRange = basebook.Worksheets("Sheet1").Cells(rNum, "A").Resize(.Rows.Count, .Columns.Count)
        End With
        destRange.Value = sourceRange.Value
        
        [COLOR=red][B]rNum = rNum + destRange.Rows.Count[/B][/COLOR]
 
        'Dong file
        mybook.Close False
 
    Next n
End If
'Tra ve mac dinh truoc khi mo
ChDrive SaveDriveDir
ChDir SaveDriveDir
With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
End With
End Sub

Hoacomay96 · 25/3/08

Em đã chạy thử code anh sửa rồi nhưng vẫn bị như cũ (các dữ liệu dán vẫn bị đè). anh nghiên cứu cách khác cứu em với.

nvson · 26/3/08

Hoacomay96 đã viết:
Em đã chạy thử code anh sửa rồi nhưng vẫn bị như cũ (các dữ liệu dán vẫn bị đè). anh nghiên cứu cách khác cứu em với.

Hi hi, mình test trên máy mình dữ liệu có bị ghi đè đâu nhỉ (??)
bạn thử Upload file của bạn lên xem nào?

hunggtg · 12/10/10

Chào các bạn

Mình có nhiều file giống như file 1.xls, 2.xls...., trong mỗi file chỉ có 1 shet và có thông tin như đính kèm, chỉ khác nhau là số lượng hạng mục trong từng báo giá khác nhau (có thể là 1 hoặc 100), nhưng dòng cuối cùng vẫn là tổng cộng (như cột B).

Bây giờ cuối tháng mình muốn tổng hợp lại cái thông tin khách hàng vào file Tong hop.sheet1, và danh sách sản phẩm đã chào vào sheet 2.

Nhờ các bạn giúp giùm nhé.

hunggtg · 13/10/10

hunggtg đã viết:
Chào các bạn

Mình có nhiều file giống như file 1.xls, 2.xls...., trong mỗi file chỉ có 1 shet và có thông tin như đính kèm, chỉ khác nhau là số lượng hạng mục trong từng báo giá khác nhau (có thể là 1 hoặc 100), nhưng dòng cuối cùng vẫn là tổng cộng (như cột B).

Bây giờ cuối tháng mình muốn tổng hợp lại cái thông tin khách hàng vào file Tong hop.sheet1, và danh sách sản phẩm đã chào vào sheet 2.

Nhờ các bạn giúp giùm nhé.

Nhờ các bạn giúp giùm nhé

thetrungkien · 15/8/11

Tổng hợp nhiều file

nvson đã viết:

Bạn dùng đoạn code sau:

Mã:

Option Explicit
Sub Example5()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim n As Long, rNum As Long
 
Dim MyPath As String
Dim SaveDriveDir As String
Dim FName As Variant
 
SaveDriveDir = CurDir
MyPath = "D:\TXT\"
ChDrive MyPath
ChDir MyPath
 
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=MyPath & "tong.xls", FileFormat:=xlExcel8, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
 
FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", MultiSelect:=True)
If IsArray(FName) Then
    Set basebook = ActiveWorkbook
    rNum = 1
            
    For n = LBound(FName) To UBound(FName)
        Set mybook = Workbooks.Open(FName(n))
        
        'Day chinh la vung ma ban can copy (Vung A10:E20 trong sheet co ten la Sheet1
        Set sourceRange = mybook.Worksheets("Sheet1").Range("[COLOR=red][B]A10:E20[/B][/COLOR]")
        rNum = (n - 1) * sourceRange.Rows.Count + 1
                
        'Xac dinh o de copy
        Set destrange = basebook.Worksheets("Sheet1").Cells(rNum, "A")
                   
        With sourceRange
            Set destrange = basebook.Worksheets("Sheet1").Cells(rNum, "A").Resize(.Rows.Count, .Columns.Count)
        End With
        destrange.Value = sourceRange.Value
        
        'Dong file
        mybook.Close False
        
    Next n
End If
'Tra ve mac dinh truoc khi mo
ChDrive SaveDriveDir
ChDir SaveDriveDir
With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
End With
End Sub

Hay quá bạn ơi cảm ơn bạn mình cũng rất cần nó
Tuy nhiên yêu cầu của mình hơi phức tạp một chút mong bạn chỉ chỉ giáo nha
- Của mình có nhiều file, trong mối file.xls có 12 sheet (từ tháng 01-12, được đặt tên là: 1_2011 đến ... 12_2011) có cấu trúc các sheet giống nhau
bây giờ mình muốn:
1. tổng hợp số liệu của từng Cells ví dụ cộng Cells (C13) của các sheet("7_2011) của tất cả các file.xls vào sheet1 của file Tonghop.xls
mong các cao thủ chỉ giáo, mình up file VD kèm nha'

Tổng hợp dữ liệu từ nhiều File vào 1 file Tong.xls (1 người xem)

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

Thành viên chính thức

Geotechnics

Thành viên chính thức

Geotechnics

Thành viên chính thức

Thành viên chính thức

Geotechnics

Thành viên chính thức

Geotechnics

Thành viên chính thức

Geotechnics

(*_*)

Thành viên chính thức

Thành viên chính thức

Geotechnics

Thành viên chính thức

Geotechnics

Thành viên chính thức

File đính kèm

Thành viên chính thức

Thành viên mới

File đính kèm

Đếm ngược thời gian

(_)