(Share) Hàm tự tạo liên kết động đến dữ liệu file đang đóng. (2 người xem)

[nttcntn]

Khi lang thang trên Internet tìm hiểu về vấn đề tạo liên kết động đến file đóng mình tìm được hàm pull của tác giả Harlan Grove
Hàm này có thể tham chiếu đến dữ liệu của file đang đóng.
Mình gửi lên ai cần thì dùng nhé.

Function pull(xref As String) As Variant
'inspired by Bob Phillips and Laurent Longre
'but written by Harlan Grove
'-----------------------------------------------------------------
'Copyright (c) 2003 Harlan Grove.
'
'This code is free software; you can redistribute it and/or modify
'it under the terms of the GNU General Public License as published
'by the Free Software Foundation; either version 2 of the License,
'or (at your option) any later version.
'-----------------------------------------------------------------
Dim xlapp As Object, xlwb As Workbook
Dim b As String, r As Range, c As Range, n As Long


pull = Evaluate(xref)


If CStr(pull) = CStr(CVErr(xlErrRef)) Then
    On Error GoTo CleanUp 'immediate clean-up at this point


    Set xlapp = CreateObject("Excel.Application")
    Set xlwb = xlapp.Workbooks.Add 'needed by .ExecuteExcel4Macro


    On Error Resume Next 'now clean-up can wait


    n = InStr(InStr(1, xref, "]") + 1, xref, "!")
    b = Mid(xref, 1, n)


    Set r = xlwb.Sheets(1).Range(Mid(xref, n + 1))


        If r Is Nothing Then
            pull = xlapp.ExecuteExcel4Macro(xref)
        Else
            For Each c In r
                c.Value = xlapp.ExecuteExcel4Macro(b & c.Address(1, 1, xlR1C1))
            Next c


            pull = r.Value
        End If


CleanUp:
If Not xlwb Is Nothing Then xlwb.Close 0
If Not xlapp Is Nothing Then xlapp.Quit
Set xlapp = Nothing
End If
End Function

Trong đó tham số xref có dạng
"'" & đường dẩn & "[" Tên file & "]" & Tên sheet & "'!" & địa chỉ cell

 

[Kiều Mạnh]

Khi lang thang trên Internet tìm hiểu về vấn đề tạo liên kết động đến file đóng mình tìm được hàm pull của tác giả Harlan Grove
Hàm này có thể tham chiếu đến dữ liệu của file đang đóng.
Mình gửi lên ai cần thì dùng nhé.

Function pull(xref As String) As Variant
'inspired by Bob Phillips and Laurent Longre
'but written by Harlan Grove
'-----------------------------------------------------------------
'Copyright (c) 2003 Harlan Grove.
'
'This code is free software; you can redistribute it and/or modify
'it under the terms of the GNU General Public License as published
'by the Free Software Foundation; either version 2 of the License,
'or (at your option) any later version.
'-----------------------------------------------------------------
Dim xlapp As Object, xlwb As Workbook
Dim b As String, r As Range, c As Range, n As Long


pull = Evaluate(xref)


If CStr(pull) = CStr(CVErr(xlErrRef)) Then
    On Error GoTo CleanUp 'immediate clean-up at this point


    Set xlapp = CreateObject("Excel.Application")
    Set xlwb = xlapp.Workbooks.Add 'needed by .ExecuteExcel4Macro


    On Error Resume Next 'now clean-up can wait


    n = InStr(InStr(1, xref, "]") + 1, xref, "!")
    b = Mid(xref, 1, n)


    Set r = xlwb.Sheets(1).Range(Mid(xref, n + 1))


        If r Is Nothing Then
            pull = xlapp.ExecuteExcel4Macro(xref)
        Else
            For Each c In r
                c.Value = xlapp.ExecuteExcel4Macro(b & c.Address(1, 1, xlR1C1))
            Next c


            pull = r.Value
        End If


CleanUp:
If Not xlwb Is Nothing Then xlwb.Close 0
If Not xlapp Is Nothing Then xlapp.Quit
Set xlapp = Nothing
End If
End Function

Trong đó tham số xref có dạng
"'" & đường dẩn & "[" Tên file & "]" & Tên sheet & "'!" & địa chỉ cell

Hàm này viết cách đây 13 mùa xu hào bắp cải rồi ...Làm biếng test quá
đề lấy dữ liệu 1 Cells Giờ ta xài xúc tích ngắn gọn như sau

Sub Test()
    Dim DuongDan As String
    DuongDan = "'" & ThisWorkbook.Path & "\"
    Range("A1") = ExecuteExcel4Macro(DuongDan & "[A.xls]Sheet1'!R1C1") ''Lay O A1 Sheet1 File A.xls
End Sub

 

[nttcntn]

Cái sub của bác mình biết rùi. ý mình là muốn dùng hàm chứ không dùng thủ tục
Dùng thủ tục thì chỉ copy dữ liệu từ file nguồn sang file thôi
Còn dùng hàm thì có thể lấy dữ liệu linh động hơn khi kết hợp với các hàm tham chiếu sẵn có của excell (Vlookup, match, ...) giống như hàm Indirect nhưng hàm này dùng khi file nguồn đóng
Khi đó chỉ cần thay dữ liệu đầu vào tại file đang mở ta sẽ lấy được dữ liệu tương ứng từ file đóng
Nhưng mình thấy nó chạy rất chậm khi mỗi lần thay đổi số liệu. ko biết có cách nào cải thiện được tốc độ hàm này không

 

[doveandrose]

Khi lang thang trên Internet tìm hiểu về vấn đề tạo liên kết động đến file đóng mình tìm được hàm pull của tác giả Harlan Grove
Hàm này có thể tham chiếu đến dữ liệu của file đang đóng.
Mình gửi lên ai cần thì dùng nhé.

cảm ơn bạn đã chia sẽ , thế mà trước giờ mình cứ ngỡ file đang mở mới lấy dữ liệu được , cứ tiếp tục phát huy bạn nhé

 

[trongtrung1504]

Khi lang thang trên Internet tìm hiểu về vấn đề tạo liên kết động đến file đóng mình tìm được hàm pull của tác giả Harlan Grove
Hàm này có thể tham chiếu đến dữ liệu của file đang đóng.
Mình gửi lên ai cần thì dùng nhé.

Function pull(xref As String) As Variant
'inspired by Bob Phillips and Laurent Longre
'but written by Harlan Grove
'-----------------------------------------------------------------
'Copyright (c) 2003 Harlan Grove.
'
'This code is free software; you can redistribute it and/or modify
'it under the terms of the GNU General Public License as published
'by the Free Software Foundation; either version 2 of the License,
'or (at your option) any later version.
'-----------------------------------------------------------------
Dim xlapp As Object, xlwb As Workbook
Dim b As String, r As Range, c As Range, n As Long


pull = Evaluate(xref)


If CStr(pull) = CStr(CVErr(xlErrRef)) Then
    On Error GoTo CleanUp 'immediate clean-up at this point


    Set xlapp = CreateObject("Excel.Application")
    Set xlwb = xlapp.Workbooks.Add 'needed by .ExecuteExcel4Macro


    On Error Resume Next 'now clean-up can wait


    n = InStr(InStr(1, xref, "]") + 1, xref, "!")
    b = Mid(xref, 1, n)


    Set r = xlwb.Sheets(1).Range(Mid(xref, n + 1))


        If r Is Nothing Then
            pull = xlapp.ExecuteExcel4Macro(xref)
        Else
            For Each c In r
                c.Value = xlapp.ExecuteExcel4Macro(b & c.Address(1, 1, xlR1C1))
            Next c


            pull = r.Value
        End If


CleanUp:
If Not xlwb Is Nothing Then xlwb.Close 0
If Not xlapp Is Nothing Then xlapp.Quit
Set xlapp = Nothing
End If
End Function

Trong đó tham số xref có dạng
"'" & đường dẩn & "[" Tên file & "]" & Tên sheet & "'!" & địa chỉ cell

theo mình biết thì excel ko lấy được data khi file đóng. nó có mở nhưng chạy ngầm ko show ra đấy. thử kiểm tra tiến trình chạy của file bạn đang lấy dữ liệu xem. code này trước đây tuần gặp rồi