Tìm kiếm dữ liệu trên File excel đang đóng.

Chia sẻ bởi:hands

★★★★★

‹ Tách dữ liệu theo điều kiện thành... Tham chiếu dữ liệu từ file đóng... ›

Quảng cáo

Cảm ơn nhiều!

Nhờ anh chị viết dùm em hàm GetData lấy dữ liệu trên 1 cell của một file đang đóng (CQ.xls).
-file CQ.xls: Sheet: TC_Ngoai có dữ liệu như sau:
STT SKU NCC TEN HANG
1 3109735 TP KIWI L1
2 3157509 NC KiWi VANG
3 3177315 BT Nho Den

– Mở file Main.xls.Tại một cell bất kì gõ hàm macro:
=GetData(ChuoiSoSanh,tenfile,tenSheet,VungTim)
Ví dụ: tìm Chuoi so sanh là: 3157509, tên file :CQ.xls, tên Sheet la: TC_Ngoai, Vùng tìm la: "A1:E5".
==> Trả về giá trị là:KiWi VANG
Cảm ơn nhiều!

Thế là VLOOKUP rồi còn gì… cứ thế mà xài, cần gì viết code

Em đã viết đoạn code dưới đây nhưng lại bị lổi:

Public Function GetData(sss As String, sFile As String, sSheet As String, sAddr As String) As String
  Dim pLink As String, iR As Long
  If Len(Dir(sFile)) Then
    pLink = "'" & Replace(sFile, Dir(sFile), "[" & Dir(sFile) & "]") & sSheet & "'!"

For iR = 1 To 50
        If (ExecuteExcel4Macro(pLink & Range(sAddr).Cells(iR, 2).Address(, , 2)) = sss) Then
            GetData = ExecuteExcel4Macro(pLink & Range(sAddr).Cells(iR, 10).Address(, , 2))
            iR = 50
        Else
        GetData = 0
        End If
    Next iR

End If

End Function

Cũng hàm Getdata , nhưng nếu dùng command button ( sử dụng Test() ) thì lại chạy bình thường.
Thật sự khó hiểu. Rất mong các cao thủ sửa dùm

Sub Test()
  Dim sFile As String, sSheet As String, sAddr As String, sss As String
  sss = "3157509"
  sFile = ThisWorkbook.Path & "CQ.xls"
  sSheet = "TC_Ngoai"
  sAddr = "A1:J50"
  Range("A1") = GetData(sss, sFile, sSheet, sAddr)
End Sub
Public Function GetData(sss As String, sFile As String, sSheet As String, sAddr As String) As String
  Dim pLink As String, iR As Long
  If Len(Dir(sFile)) Then
    pLink = "'" & Replace(sFile, Dir(sFile), "[" & Dir(sFile) & "]") & sSheet & "'!"

For iR = 1 To 50
        If (ExecuteExcel4Macro(pLink & Range(sAddr).Cells(iR, 2).Address(, , 2)) = sss) Then
            GetData = ExecuteExcel4Macro(pLink & Range(sAddr).Cells(iR, 10).Address(, , 2))
            iR = 50
        Else
        GetData = 0
        End If
    Next iR   
  End If 
End Function

Nhờ anh chị sửa dùm.

Ai nói VLOOKUP không truy vấn được dữ liệu file đang đóng? Bạn đã thử chưa?
Đừng nói là file nguồn đang đóng, thậm chí file nguồn ấy bị xóa luôn thì VLOOKUP vẫn lấy được dữ liệu (ở phiên cuối cùng mà file nguồn còn tồn tại)
————–
Còn nếu bạn muốn dùng macro 4 thì có link này:
[URL='https://www.giaiphapexcel.com/forum/showthread.php?39312-D%C3%B9ng-Macro-4-%C4%91%E1%BB%83-l%E1%BA%A5y-d%E1%BB%AF-li%E1%BB%87u-t%E1%BB%AB-1-file-%C4%91ang-%C4%91%C3%B3ng']https://www.giaiphapexcel.com/forum/…ng-Macro-4-để-lấy-dữ-liệu-từ-1-file-đang-đóng

Khi chạy debug nó báo lỗi ở dòng ExecuteExcel4Macro…
Em đã sửa đi sửa lại mất cả tuần nay mà chưa được. Em thực sự rất cần giải quyết cái hàm này. Thanks!

Code sai tùm lum, chạy được mới lạ!
Thêm nữa, bạn lấy dữ liệu từ file đang đóng, lại kết hợp lọc theo điều kiện —> Theo tôi như thế là không hay!
Cái gì ra cái đó! Bạn nên viết code cho rõ ràng:
– Code nào lấy dữ liệu thì chỉ làm công việc lấy dữ liệu thôi
– Code nào lọc dữ liệu thì chỉ làm công việc lọc dữ liệu
Tôi viết lại như sau:
1> Code lấy dữ liệu từ file đang đóng

Function GetData(ByVal sFile As String, ByVal sSheet As String, ByVal sAddr As String)
Dim pLink As String, iR As Long, iC As Long, Arr
If Len(Dir(sFile)) Then
With Range(sAddr)
ReDim Arr(1 To .Rows.Count, 1 To .Columns.Count)
pLink = "'" & Replace(sFile, Dir(sFile), "[" & Dir(sFile) & "]") & sSheet & "'!"
For iR = 1 To UBound(Arr, 1)
For iC = 1 To UBound(Arr, 2)
Arr(iR, iC) = ExecuteExcel4Macro(pLink & .Cells(iR, iC).Address(, , 2))
Next iC
Next iR
End With
GetData = Arr
End If
End Function
2> Code lọc dữ liệu theo điều kiện:

Function Filter2DArray(ByVal sArray, ByVal ColIndex As Long, ByVal FindStr As String, ByVal HasTitle As Boolean)
Dim tmpArr, i As Long, j As Long, Arr, Dic, TmpStr, Tmp, Chk As Boolean, TmpVal As Double
On Error Resume Next
Set Dic = CreateObject("Scripting.Dictionary")
tmpArr = sArray
ColIndex = ColIndex + LBound(tmpArr, 2) – 1
Chk = (InStr("><=", Left(FindStr, 1)) > 0)
For i = LBound(tmpArr, 1) – HasTitle To UBound(tmpArr, 1)
If Chk And FindStr <> "" Then
TmpVal = CDbl(tmpArr(i, ColIndex))
If Evaluate(TmpVal & FindStr) Then Dic.Add i, ""
Else
If Left(FindStr, 1) = "!" Then
If Not (UCase(tmpArr(i, ColIndex)) Like UCase(Mid(FindStr, 2, Len(FindStr)))) Then Dic.Add i, ""
Else
If UCase(tmpArr(i, ColIndex)) Like UCase(FindStr) Then Dic.Add i, ""
End If
End If
Next
If Dic.Count > 0 Then
Tmp = Dic.Keys
ReDim Arr(LBound(tmpArr, 1) To UBound(Tmp) + LBound(tmpArr, 1) – HasTitle, LBound(tmpArr, 2) To UBound(tmpArr, 2))
For i = LBound(tmpArr, 1) – HasTitle To UBound(Tmp) + LBound(tmpArr, 1) – HasTitle
For j = LBound(tmpArr, 2) To UBound(tmpArr, 2)
Arr(i, j) = tmpArr(Tmp(i – LBound(tmpArr, 1) + HasTitle), j)
Next
Next
If HasTitle Then
For j = LBound(tmpArr, 2) To UBound(tmpArr, 2)
Arr(LBound(tmpArr, 1), j) = tmpArr(LBound(tmpArr, 1), j)
Next
End If
End If
Filter2DArray = Arr
End Function
3> Code chính để chạy:

Sub Main()
Dim sFile As String, sSheet As String, sAddr As String, FindStr As String, tmpArr, Arr
FindStr = "3157509"
sFile = ThisWorkbook.Path & "CQ.xls"
sSheet = "TC_Ngoai"
sAddr = "A1:J50"
tmpArr = GetData(sFile, sSheet, sAddr)
Arr = Filter2DArray(tmpArr, 10, FindStr, True)
Range("A1").Resize(UBound(Arr, 1), UBound(Arr, 2)).Value = Arr
End Sub
Kiểm tra thử nhé