Lấy dử liệu từ file khác (post bài dùm bạn) (2 người xem)

Liên hệ QC

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

ndu96081631

Huyền thoại GPE
Thành viên BQT
Super Moderator
Tham gia
5/6/08
Bài viết
30,703
Được thích
53,964
Đây là câu hỏi của 1 bạn nhờ giúp:
phuong ngoc đã viết:
Nhờ anh chỉ giúp:
Nguồn: các file dữ liệu excel hằng ngày có cấu trúc bảng dữ liệu giống nhau, chỉ khác tên file ddmmyyyy.xls.

Đích: file excel tổng hợp dữ liệu cuối tháng tonghop.xls
Làm thế nào viết code cho nút lệnh để import 1 số trường dữ liệu của các file dữ liệu hằng ngày trong tháng vào file tonghop.xls có cấu trúc bảng đã định sẵn.
Post lên nhờ các bạn giúp hộ
Cảm ơn!
 

File đính kèm

Sao không cho vào một file mà là chi nhiều file vậy.
 
Sao không cho vào một file mà là chi nhiều file vậy.
Đây là file của tác giã, không phải của tôi...
- Nếu ngay bây giờ ta xây dựng dử liệu thì sẽ làm như Salam đã nói
- Còn như đây là dử liệu sẳn có trước giờ thì.. đành cố làm thôi
Salam thử xem (tôi nghĩ bạn dư sức)
 
Dùng hàm indirect đi bạn. Chúc bạn thành công.
Trước hết là dùng hàm value chuyển ngày tháng tại dòng 3 thanh 01012009.
B2 =IF(VALUE(DAY(B3))<10;"0"&VALUE(DAY(B3));VALUE(DAY(B3)))&IF(VALUE(MONTH(B3))<10;"0"&VALUE(MONTH(B3));VALUE(MONTH(B3)))&VALUE(YEAR(B3))

Sau đó dùng hàm indirect:
b4=VLOOKUP(A4;INDIRECT("["&B2&".xls]dulieu!A$2:D$5");4;0)
rồi Ctrl+R chép qua hết là xong.
Nhưng nhớ là open các file kia mới thấy được.}}}}}
 
Lần chỉnh sửa cuối:
Dùng hàm indirect đi bạn. Chúc bạn thành công.
Trước hết là dùng hàm value chuyển ngày tháng tại dòng 3 thanh 01012009.
B2 =IF(VALUE(DAY(B3))<10;"0"&VALUE(DAY(B3));VALUE(DAY(B3)))&IF(VALUE(MONTH(B3))<10;"0"&VALUE(MONTH(B3));VALUE(MONTH(B3)))&VALUE(YEAR(B3))

Sau đó dùng hàm indirect:
b4=VLOOKUP(A4;INDIRECT("["&B2&".xls]dulieu!A$2:D$5");4;0)
rồi Ctrl+R chép qua hết là xong.
Nhưng nhớ là open các file kia mới thấy được.}}}}}
Đâu có được!
INDIRECT bắt buộc phải mở file lên ---> Có 100 file cũng mở hết sao?
Thêm nữa: Công thức chuyển ngày tháng đâu cần dài thế:
B2 =TEXT(B3,"ddmmyyyy")
là đủ rồi!
 
Lần chỉnh sửa cuối:
Tôi xin giới thiệu cách dùng ADO.

Hướng giải quyết:
_ Tôi sẽ sắp xếp các tập tin cần lấy dữ liệu và tập tin tổng hợp vào cùng một thư mục.
_ Tôi sẽ kết hợp thủ tục lấy dữ liệu từ một workbook đóng từ đây
http://www.erlandsendata.no/english/index.php?d=envbadacimportwbado

Mã:
'GetDataFromClosedWorkbook "C:\FolderName\WorkbookName.xls", "A1:B21", ActiveCell, False
'GetDataFromClosedWorkbook "C:\FolderName\WorkbookName.xls", "MyDataRange", Range("B3"), True

Sub GetDataFromClosedWorkbook(SourceFile As String, SourceRange As String, _
                              TargetRange As Range, IncludeFieldNames As Boolean)
' requires a reference to the Microsoft ActiveX Data Objects library
' if SourceRange is a range reference:
'   this will return data from the first worksheet in SourceFile
' if SourceRange is a defined name reference:
'   this will return data from any worksheet in SourceFile
' SourceRange must include the range headers
'
    Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset
    Dim dbConnectionString As String
    Dim TargetCell As Range, i As Integer
    dbConnectionString = "DRIVER={Microsoft Excel Driver (*.xls)};" & _
                         "ReadOnly=1;DBQ=" & SourceFile
    Set dbConnection = New ADODB.Connection
    On Error GoTo InvalidInput
    dbConnection.Open dbConnectionString    ' open the database connection
    Set rs = dbConnection.Execute("[" & SourceRange & "]")
    Set TargetCell = TargetRange.Cells(1, 1)
    If IncludeFieldNames Then
        For i = 0 To rs.Fields.Count - 1
            TargetCell.Offset(0, i).Formula = rs.Fields(i).Name
        Next i
        Set TargetCell = TargetCell.Offset(1, 0)
    End If
    TargetCell.CopyFromRecordset rs
    rs.Close
    dbConnection.Close    ' close the database connection
    Set TargetCell = Nothing
    Set rs = Nothing
    Set dbConnection = Nothing
    On Error GoTo 0
    Exit Sub
InvalidInput:
    MsgBox "The source file or source range is invalid!", _
           vbExclamation, "Get data from closed workbook"
End Sub

Và thủ tục liệt kê các tập tin Excel trong cùng một thư mục:

Mã:
Sub ListFiles()
    Dim Directory As String
    Dim r As Long
    Dim f As String
    Directory = Application.ThisWorkbook.Path & "\"    
    r = 1
    '   Insert headers
    Cells(r, 1) = "FileName"
    Cells(r, 2) = "Size"
    Cells(r, 3) = "Date/Time"
    Range("A1:C1").Font.Bold = True
    '   Get first file
    f = Dir(Directory, vbReadOnly + vbHidden + vbSystem)
    Do While f <> ""
        If Right$(f, 4) = ".xls" And f <> ThisWorkbook.Name Then
            r = r + 1
            Cells(r, 1) = f
            Cells(r, 2) = FileLen(Directory & f)
            Cells(r, 3) = FileDateTime(Directory & f)
        End If
        '   Get next file
        f = Dir()
    Loop
End Sub

Như vậy công việc của tôi là kết hợp hai thủ tục ở trên để lấy dữ liệu ra theo yêu cầu của mình.

Dữ liệu trên các tập tin như sau:

NhapTuNhieuWb.gif



(Tổng hợp hai thủ tục trên: xin các bạn tiếp sức.)

Lê Văn Duyệt
 
Lần chỉnh sửa cuối:
Vấn đề bạn khó khăn hơi khác tôi một tí nhưng tôi cung có vấn đề này rất khó khăn trong công việc, mong các bạn giúp giùm
Tôi thường làm trong excel lấy dữ liệu từ nhiều file khác nhau, nếu mở các file đó ra thì việc tham gia tính toán thì nhanh nhưng nếu không mở ra hoặc mở một file nào đó nhưng có dữ liệu của các file khác thì máy tính làm cái gì đó một hồi rất rất lâu (khoảng 7-10 phút) và nhiều thông báo mới mở được file cần mở
Có cách nào, lấy dữ liệu từ nhiều file khác nhau tham gia tính toán mà không cần mở file đó ra không các bạn
Ví dụ tôi tạo ra 2 file một file phiếu thu, các chứng từ liên quan đến thu và 1 file phiếu chi và các chứng từ khác liên quan đến chi
Tôi tính số dư trong file phiếu chi nhưng khi file phiếu thu chưa mở mà file phiếu chi mở trước thì rất lâu mới mở được
Rất mong các bạn chỉ giúp
 
hay, học excel nhiều càng thấy mình còn ngu lắm
 
Tôi xin gửi bạn giải pháp dùng A-Tools.

Bạn hãy đọc kỹ và làm theo file "Huong dan truoc khi dung!.txt" trước khi mở file "Tônghp.xls".

Chúc bạn thành công!
 

File đính kèm

Lần chỉnh sửa cuối:
Web KT

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

Back
Top Bottom