Lấy dữ liệu từ các file khác nhau?

Liên hệ QC
S

solecao

Thành viên mới
Tham gia
20/9/09
Bài viết
25
Được thích
2
Mình đang có nhiệm vụ tổng hợp số liệu lại từ các file Excel khác nhau trong cùng một thư mục và thư mục con của nó vào một file Excel duy nhất. ví dụ:

Thư mục chính "abc" có 2 file xls là "def.xls" và "efg.xls" và 1 thư mục con "subfolder". Trong thư mục con "subfolder" có chứa vài file excel khác".

Trong file chạy macro, số liệu cần thống kê ví dụ là tất cả các ô A1 trong Sheet1 của tất cả các file nằm trong thư mục "abc" và thư mục con của nó mà không cần phải mở các file đấy ra. Số file tổng quát là không biết có bao nhiêu file.

Mong các cao thủ chỉ giáo.
 
Lần chỉnh sửa cuối:
Cám ơn bạn đã hỏi.

Các ô A1 này được ghi vào file hiện hành (đang mở , new file ) và có dạng 2 cột: Cột A chứa tên file của các file trong thư mục cần thống kê, cột B với các hàng tương ứng sẽ chứa số liệu của các ô A1 của các file đó. Việc tham khảo này không biết có mất thời gian không (nếu Excel không cần mở file mà vẫn lấy được dữ liệu thì nhanh hơn).
 
Bạn tải File đính kèm về, mở ra và chọn Enables Macro.

Vào bảng tính --> nhấn nút --> Nhập đường dẫn chính xác tới thư mục chứa các file --> OK.

Nếu muốn hãy chỉnh sửa code cho phù hợp :

PHP: 
Sub GetData()
  Dim i As Long, FolderName As String
  Dim ThisWb As Workbook, FindWb As Workbook
  
  Application.ScreenUpdating = False
  Set ThisWb = ThisWorkbook
  FolderName = InputBox("Nhap duong dan toi thu muc chua cac file Excel can lay du lieu : ")
  
  On Error Resume Next
  With Application.FileSearch
    .SearchSubFolders = True
    .LookIn = FolderName
    .Filename = "*.xls"
    If .Execute() > 0 Then
        For i = 1 To .FoundFiles.Count
            Set FindWb = Workbooks.Open(.FoundFiles(i))
            With ThisWb.Sheets(1)
                .Range("A" & i + 1).Value = FindWb.Name
                .Range("B" & i + 1).Value = FindWb.Sheets(1).Range("A1").Value
            End With
            FindWb.Close (False)
        Next i
    End If
  End With
  Application.ScreenUpdating = True
End Sub
Xem File ở đây, chỉ dùng với Excel 2003 :
 

File đính kèm

Bác chịu khó chuyển sang 2007 được không, vì máy đang cài 2007 chả lẽ xóa đi. Với lại test trên 2007, nhưng vẫn dùng .xls không chạy
 
ndu96081631 đã viết:
Tham khảo bài viết này:
http://www.giaiphapexcel.com/forum/showthread.php?t=25782
Lấy tên file trong Folder và SubFolder ---> Code dùng được cho Excel 2003 và Excel 2007
Nhấp chuột vào đây để mở rộng...

Sau 1 hồi "vọc" thử và...sai cuối cùng em cũng làm được, cảm giác này rất...đã --=0--=0--=0

PHP: 
Private i As Long
Sub GetData(FolderName As String)
    Dim File As Scripting.File, SubFolder As Scripting.Folder
    Dim ThisWb As Workbook, FindWb As Workbook
    
    Application.ScreenUpdating = False
    Set ThisWb = ThisWorkbook
    
    On Error Resume Next
    With New Scripting.FileSystemObject
        With .GetFolder(FolderName)
            For Each File In .Files
                If InStr(File.Name, "xls") Then
                    Set FindWb = Workbooks.Open(File.Path)
                    With ThisWb.Sheets(1)
                        .Range("A" & i + 1).Value = FindWb.Name
                        .Range("B" & i + 1).Value = FindWb.Sheets(1).Range("A1").Value
                    End With
                    FindWb.Close (False)
                    i = i + 1
                End If
            Next File
            For Each SubFolder In .SubFolders
                Call GetData(SubFolder.Path)
            Next SubFolder
        End With
    End With
End Sub

Sub Run()
    Dim FolderName As String
    i = 1
    FolderName = InputBox("Nhap duong dan toi thu muc chua cac file Excel can lay du lieu : ")
    Call GetData(FolderName)
End Sub
Bác chịu khó chuyển sang 2007 được không, vì máy đang cài 2007 chả lẽ xóa đi. Với lại test trên 2007, nhưng vẫn dùng .xls không chạy
Nhấp chuột vào đây để mở rộng...
Bạn xem File :
 

File đính kèm

Cám ơn 2 bác ndu và ptlong0x1 đã nhiệt tình giúp đỡ, nhưng 2 bác cho hỏi : trong đoạn code có lệnh mở file, nhưng không biết có mở thực tê hay không vì thấy tốc độ rất nhanh.
 
Thực tế là có mở File đó bạn, nhưng sau đó đóng lại ngay và không làm thay đổi File vừa mở, nhanh là vì trong thư mục của bạn có ít File, bạn tìm thư mục nào nhiều File 1 chút sẽ thấy chậm ngay thôi mà.
 
ptlong04x1 đã viết:
Sau 1 hồi "vọc" thử và...sai cuối cùng em cũng làm được, cảm giác này rất...đã --=0--=0--=0

PHP: 
Private i As Long
Sub GetData(FolderName As String)
    Dim File As Scripting.File, SubFolder As Scripting.Folder
    Dim ThisWb As Workbook, FindWb As Workbook
    
    Application.ScreenUpdating = False
    Set ThisWb = ThisWorkbook
    
    On Error Resume Next
    With New Scripting.FileSystemObject
        With .GetFolder(FolderName)
            For Each File In .Files
                If InStr(File.Name, "xls") Then
                    Set FindWb = Workbooks.Open(File.Path)
                    With ThisWb.Sheets(1)
                        .Range("A" & i + 1).Value = FindWb.Name
                        .Range("B" & i + 1).Value = FindWb.Sheets(1).Range("A1").Value
                    End With
                    FindWb.Close (False)
                    i = i + 1
                End If
            Next File
            For Each SubFolder In .SubFolders
                Call GetData(SubFolder.Path)
            Next SubFolder
        End With
    End With
End Sub

Sub Run()
    Dim FolderName As String
    i = 1
    FolderName = InputBox("Nhap duong dan toi thu muc chua cac file Excel can lay du lieu : ")
    Call GetData(FolderName)
End Sub
Bạn xem File :
Nhấp chuột vào đây để mở rộng...
Cũng còn vài chổ nên lưu ý:
- Phần gõ tên đường dẩn thư mục bằng InputBox theo tôi là... quá dở ---> Bạn có thể dùng đại khái thế này:
PHP: 
Sub Run()
  With CreateObject("Shell.Application")
    On Error Resume Next
    GetData .BrowseForFolder(0, "", 1).Self.Path
  End With
End Sub
Bạn hãy hoàn chỉnh tiếp cho nó
- Câu lệnh If InStr(File.Name, "xls") Then e rằng không chính xác ---> Lý ra phải dùng hàm LEFT (vì lở trong tên file có chữ xls nhưng không phải file Excel... ví dụ file nduxls.swf)
- Phương thức mở file để lấy thông tin chỉ có thể hoạt động với các file nhập liệu thông thường ---> Trong các file ấy nếu có 1 file dùng code VBA và đang bị lổi hoặc có file nào đó xài UserForm khi khởi động file thì làm cách nào bạn lấy được dử liệu?... vân vân và vân vân...
Tóm lại: Code lấy tên file chỉ là định vị trí của file trên ổ cứng... Còn việc lấy dử liệu theo tôi nên dùng ADO ---> File bị lổi hoặc file có xài UserForm và chơi bất cứ trò gì nó cũng lấy được tuốt
-----------
Còn nhiều việc bạn phải làm lắm ---> vất vả nhé (nhưng vui)
Ẹc... Ec...
 
cho hỏi một câu có vẻ hơi ngớ ngẩn : ADO là gì vậy bác , cái này dùng chức năng tìm kiếm không thấy.
 
solecao đã viết:
cho hỏi một câu có vẻ hơi ngớ ngẩn : ADO là gì vậy bác , cái này dùng chức năng tìm kiếm không thấy.
Nhấp chuột vào đây để mở rộng...
ADO là viết tắt của ActiveX Data Object... Còn cụ thể nó là cái gì chắc bạn phải search trên diển đàn
Quan trọng tôi nghĩ bạn cần biết nó làm được cái gì (chứ không phải biết nó là cái gì), đúng không?
Bài toán của bạn, tôi làm bằng ADO đây
PHP: 
Private Sub GetData(FolderName As String, InSub As Boolean)
  'requires a reference to the Microsoft Scripting Runtime
  Dim FileItem As Scripting.File, SubFolder As Scripting.Folder, FileName As String, tArray
  Dim r As Long, c As Long
  On Error Resume Next
  With New Scripting.FileSystemObject
    With .GetFolder(FolderName)
      For Each FileItem In .Files
        If LCase(Right(FileItem.Name, 4)) = ".xls" Or _
          LCase(Right(FileItem.Name, 5)) = ".xlsx" Or _
          LCase(Right(FileItem.Name, 5)) = ".xlsm" Then
          FileName = FolderName & "\" & FileItem.Name
          With Range("A65536").End(xlUp)
            .Offset(1, 0) = FileName
            .Offset(1, 1) = ReadDataFromWb(FileName, "A1:A1")
          End With
        End If
      Next FileItem
      If InSub Then
        For Each SubFolder In .subFolders
          GetData SubFolder.Path, True
        Next SubFolder
      End If
    End With
  End With
End Sub
PHP: 
Private Function ReadDataFromWb(SourceFile As String, SourceRange As String)
  'requires a reference to the Microsoft ActiveX Data Objects library
  Dim szConnect As String
  If Val(Application.Version) < 12 Then
    szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & SourceFile & ";Extended Properties=""Excel 8.0;HDR=No"";"
  Else
    szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & SourceFile & ";Extended Properties=""Excel 12.0;HDR=No"";"
  End If
  With New ADODB.Connection
    .Open szConnect
    With .Execute("[" & SourceRange & "]")
      ReadDataFromWb = .Fields(0).Value
      .Close
    End With
    .Close
  End With
End Function
PHP: 
Sub Main()
  Range("A2:B60000").Clear
  With CreateObject("Shell.Application")
    On Error Resume Next
    GetData .BrowseForFolder(0, "", 1).Self.Path, True
  End With
  Columns("A:B").AutoFit
End Sub
 

File đính kèm

ptlong04x1 đã viết:
Anh giải thích giúp em mấy chữ màu đỏ với :

GetData .BrowseForFolder(0, "", 1).Self.Path
Nhấp chuột vào đây để mở rộng...
Code ấy dùng để lấy đường dẩn của thư mục mà ta đã chọn trong hộp BrowseForFolder thôi mà bạn!
Bạn thí nghiệm thế này thì biết liền:
PHP: 
Sub Test()
  With CreateObject("Shell.Application")
    MsgBox .BrowseForFolder(0, "", 1).Self.Path
  End With
End Sub
Còn mấy số 0 và 1 trong code, bạn có thể tìm hiểu bằng cách:
- Vào menu Tools\References
- Check vào mục Microsoft Shell Controls And Automation
- Tiếp theo viết 1 đoạn code ngắn như vầy:
PHP: 
Sub Test()
  Dim a As Shell
  a.BrowseForFolder(
End Sub
Sau khi bạn gõ dấu mở ngoặc, bạn sẽ thấy các gợi ý và hướng dẩn về những tham số ở bên trong
(Tôi dùng With CreateObject("Shell.Application") để không phải Add thêm Control thôi)
 
Lần chỉnh sửa cuối:
Lấy dữ liệu từ các file khác nhau

VD: mình có các file có chứa dữ liệu là số liệu trong một bảng thống kê.
mình muốn tổng hợp thành một file có bảng như vậynhwng số liệu là tổng cộng số liệu của các file chứa dữ liệu kia.
Mình làm mãi không được nhờ các bạn giúp. Công việc tổng hợp số liệu báo cáo cuối năm học sắp đến mình rất cần.
 

File đính kèm

ptlong04x1 đã viết:
Bạn tải File đính kèm về, mở ra và chọn Enables Macro.

Vào bảng tính --> nhấn nút --> Nhập đường dẫn chính xác tới thư mục chứa các file --> OK.

Nếu muốn hãy chỉnh sửa code cho phù hợp :

PHP: 
Sub GetData()
  Dim i As Long, FolderName As String
  Dim ThisWb As Workbook, FindWb As Workbook
  
  Application.ScreenUpdating = False
  Set ThisWb = ThisWorkbook
  FolderName = InputBox("Nhap duong dan toi thu muc chua cac file Excel can lay du lieu : ")
  
  On Error Resume Next
  With Application.FileSearch
    .SearchSubFolders = True
    .LookIn = FolderName
    .Filename = "*.xls"
    If .Execute() > 0 Then
        For i = 1 To .FoundFiles.Count
            Set FindWb = Workbooks.Open(.FoundFiles(i))
            With ThisWb.Sheets(1)
                .Range("A" & i + 1).Value = FindWb.Name
                .Range("B" & i + 1).Value = FindWb.Sheets(1).Range("A1").Value
            End With
            FindWb.Close (False)
        Next i
    End If
  End With
  Application.ScreenUpdating = True
End Sub
Xem File ở đây, chỉ dùng với Excel 2003 :
Nhấp chuột vào đây để mở rộng...

Gửi anh ptlong04x1,
Ở bài trên là mình lấy chỉ 1 dữ liệu ở ô A1 ra thành 1 cột riêng thôi. Còn nếu như mình muốn lấy nhiều hơn 1 dữ liệu, ví dụ như dữ liệu liên tục từ A1:A5 ra thành 5 cột, hay các dữ liệu không liên tục như A1; B2; C3; D4 thì làm sao hả anh?
 
Nhờ anh ndu96081631

xem giúp mã tại bài #12 của chủ đề này: Em muốn lấy dữ liệu tại Sheet 2 mà chưa biết cách điền tham số vào dòng
.Offset(1, 1) = ReadDataFromWb(FileName, "A1:A1") (mặc định là sheet1)
.Offset(1, 1) = ReadDataFromWb(FileName, "Sheet(2)!"&"A1:A1") (Em sửa thế này mà ko chạy được. Bac giúp em với
 
ptlong04x1 đã viết:
Sau 1 hồi "vọc" thử và...sai cuối cùng em cũng làm được, cảm giác này rất...đã --=0--=0--=0

PHP: 
Private i As Long
Sub GetData(FolderName As String)
    Dim File As Scripting.File, SubFolder As Scripting.Folder
    Dim ThisWb As Workbook, FindWb As Workbook
   
    Application.ScreenUpdating = False
    Set ThisWb = ThisWorkbook
   
    On Error Resume Next
    With New Scripting.FileSystemObject
        With .GetFolder(FolderName)
            For Each File In .Files
                If InStr(File.Name, "xls") Then
                    Set FindWb = Workbooks.Open(File.Path)
                    With ThisWb.Sheets(1)
                        .Range("A" & i + 1).Value = FindWb.Name
                        .Range("B" & i + 1).Value = FindWb.Sheets(1).Range("A1").Value
                    End With
                    FindWb.Close (False)
                    i = i + 1
                End If
            Next File
            For Each SubFolder In .SubFolders
                Call GetData(SubFolder.Path)
            Next SubFolder
        End With
    End With
End Sub

Sub Run()
    Dim FolderName As String
    i = 1
    FolderName = InputBox("Nhap duong dan toi thu muc chua cac file Excel can lay du lieu : ")
    Call GetData(FolderName)
End Sub
Bạn xem File
Nhấp chuột vào đây để mở rộng...
Bạn ơi code này chỉ lấy được 1 dòng của 1 file thôi ạ. mình muốn lấy nhiều dòng trong 1 file và nhiều file trong 1 foder
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

minhquipk
  • Question Question
Cách nhận biết những ô đã bị thay đổi giá trị khi thay đổi giá trị dữ liệu ở những ô khác
Trả lời
3
Đọc
64
le_vis
L
V
  • Question Question
Tách số liệu từ bảng tính ngang theo điều kiện
Trả lời
9
Đọc
206
HieuCD
H
P
Xin trợ giúp cách lập lịch trực tịnh tiến dần cho 1 nhóm người.
Trả lời
1
Đọc
44
hoangtuaotrang_hp_vn
H
HeSanbi
  • Đã giải quyết
LocalizeXL v1.72 - Làm nổi bật ô đang chọn và cuộn trang tự động
    • Thích
    • Yêu thích
2 3 4
Trả lời
63
Đọc
10K
125479980
125479980
H
Tìm kết quả trả về theo loại
Trả lời
9
Đọc
74
VetMini
V
LongHoang123
  • Question Question
Xin hướng dẫn: Cách tạo vùng in dựa trên dữ liệu của listbox bằng VBA!!!
Trả lời
4
Đọc
79
LongHoang123
LongHoang123
M
  • Question Question
"thủ tục để xóa dòng trống " trong Lập trình VBA trong Excel
2 3 4
Trả lời
63
Đọc
15K
SonBDND
S
Q
Hỏi về công thức dò giá
Trả lời
6
Đọc
181
thanthanhan0801
T
N
  • Question Question
VBA - copy các sheets unhide và dạng giá trị theo vùng xác định
Trả lời
6
Đọc
326
nguyenhuong34
nguyenhuong34
ThanhPhongDN
hỏi về cách thay đổi giá trị một ô sau khi nhập một giá trị vào đó
Trả lời
7
Đọc
138
vietduc147258
V
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro
    • Thích
    • Yêu thích
    • Chấp nhận
2
Trả lời
34
Đọc
13K
hungbon7890
hungbon7890
A
  • Question Question
code vba chuyển chuỗi thành text
Trả lời
11
Đọc
2K
SonBDND
S
V
Xin giúp em file theo dõi thanh toán có bị quá hạn không, quá bao nhiêu ngày và bao nhiêu tiền ạ
Trả lời
11
Đọc
308
HUONGHCKT
H
Tandattb
Xin cách Khắc phục lỗi "Path/File access error"
Trả lời
8
Đọc
287
Tandattb
Tandattb
ThanhPhongDN
Nhờ giúp đỡ về công thức trong google sheet
    • Cười
Trả lời
4
Đọc
85
thuytrangbp28
T
saobekhonglac
Tạo form vòng quay may mắn
    • Thích
2
Trả lời
35
Đọc
15K
VetMini
V
D
Thống kê dữ liệu theo điều kiện
Trả lời
5
Đọc
138
VetMini
V
noisy
Xin file tính chế độ chuyên cần
    • Cười
Trả lời
0
Đọc
46
noisy
noisy
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ
    • Cảm ơn
Trả lời
3
Đọc
715
hvnhpro
H
hanhlx88
Nhờ giúp file Excel báo lỗi: Excel cannot complete this task with available resources
Trả lời
2
Đọc
122
leonguyenz
leonguyenz
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới.
Back
Top Bottom