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

Liên hệ QC
S

syquan

Thành viên mới
Tham gia
4/4/07
Bài viết
35
Được thích
2
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!
 

File đính kèm

  • GetData_Test.rar
    94.2 KB · Đọc: 32
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
syquan đã viết:
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!
Nhấp chuột vào đây để mở rộng...
Thế là VLOOKUP rồi còn gì... cứ thế mà xài, cần gì viết code
 
Upvote 0
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


Nhờ anh chị sửa dùm.
 
Upvote 0
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
 
Upvote 0
syquan đã viết:
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ấp chuột vào đây để mở rộng...

Nếu tôi không lầm thì ExecuteExcel4Macro (và nhiều "vị" khác) không dùng được trong UDF
 
Upvote 0
syquan đã viết:
Nếu dùng Vlookup thì không truy vấn được dữ liệu khi các file dữ liệu đang đóng.
Rat mong viet gium.
Nhấp chuột vào đây để mở rộng...
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:
http://www.giaiphapexcel.com/forum/...ng-Macro-4-để-lấy-dữ-liệu-từ-1-file-đang-đóng
 
Upvote 0
siwtom đã viết:
Nếu tôi không lầm thì ExecuteExcel4Macro (và nhiều "vị" khác) không dùng được trong UDF
Nhấp chuột vào đây để mở rộ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!
 
Upvote 0
syquan đã viết:
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!
Nhấp chuột vào đây để mở rộng...
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
PHP: 
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:
PHP: 
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:
PHP: 
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é
 
Upvote 0
ndu96081631 đã viết:
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
PHP: 
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:
PHP: 
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:
PHP: 
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é
Nhấp chuột vào đây để mở rộng...

Đã Test thử nhưng chạy báo lỗi Run-time error "13" type mismatch
 
Upvote 0
Anh cho em hỏi thêm, nếu viết hàm tự tạo GetData
Ví dụ: ở trên một ô A1 của file mail.xls em chạy hàm:
=GetData("3157509","D:\GetData\CQ.xls","TC_Ngoai","A5:I100",ColumnTraVe)
Kết quả hàm này lấy ra Giá trị nằm trên cột:ColumnTraVe tưng ứng với hàng có giá trị "3157509"
Chẳng hạn tương ứng vơi sku 3157509 sẽ lấy ra kết quả: Lượng 3.3*2
 
Upvote 0
syquan đã viết:
Anh cho em hỏi thêm, nếu viết hàm tự tạo GetData
Ví dụ: ở trên một ô A1 của file mail.xls em chạy hàm:
=GetData("3157509","D:\GetData\CQ.xls","TC_Ngoai","A5:I100",ColumnTraVe)
Kết quả hàm này lấy ra Giá trị nằm trên cột:ColumnTraVe tưng ứng với hàng có giá trị "3157509"
Chẳng hạn tương ứng vơi sku 3157509 sẽ lấy ra kết quả: Lượng 3.3*2
Nhấp chuột vào đây để mở rộng...
Theo tôi bạn không nên viết hàm tự tạo rồi gõ trực tiếp trên bảng tính.. Vì nếu là vậy, thà rằng dùng VLOOKUP còn hơn
Ở đây ta dùng Sub (bấm nút, code chạy) nhầm mục đích hạn chế công thức trên bảng tính khiến cho file nặng nề ---> Bạn có hiểu không?
 
Upvote 0
ndu96081631 đã viết:
Theo tôi bạn không nên viết hàm tự tạo rồi gõ trực tiếp trên bảng tính.. Vì nếu là vậy, thà rằng dùng VLOOKUP còn hơn
Ở đây ta dùng Sub (bấm nút, code chạy) nhầm mục đích hạn chế công thức trên bảng tính khiến cho file nặng nề ---> Bạn có hiểu không?
Nhấp chuột vào đây để mở rộng...

Vấn đề này em hiểu nhưng Vlookup nó có một nhược điểm là muốn nhúng đường đẫn file động lại không được.
VD:
STT CQ
1 =vlookup(A1,D:\TTCN\[CQ.xls]TC.Ngoai'!$B$6:$P$48,15,0))
2 =vlookup(A2,D:\TTCN\[CQ.xls]TC.Ngoai'!$B$6:$P$48,15,0))

Ở đây em muốn đổi tên CQ thành HG ở trên thì công thức trong Vlookup sẽ tự động đổi thành:
STT HG
1 =vlookup(A1,D:\TTCN\[HG.xls]TC.Ngoai'!$B$6:$P$48,15,0))
2 =vlookup(A2,D:\TTCN\[HG.xls]TC.Ngoai'!$B$6:$P$48,15,0))

Em mới học excel nên không rành lắm. Rất mong sự chỉ dạy của anh. Thanks!
 
Upvote 0
Em hiểu nhưng do file của em tổng hợp từ nhiều file khác (Có cùng định dạng, số lượng file có thể thay đổi) và các giá trị tìm được trên mỗi file đó lại được đặt trên 1 cột.
 
Upvote 0
syquan đã viết:
Em hiểu nhưng do file của em tổng hợp từ nhiều file khác (Có cùng định dạng, số lượng file có thể thay đổi) và các giá trị tìm được trên mỗi file đó lại được đặt trên 1 cột.
Nhấp chuột vào đây để mở rộng...
Nếu vậy e rằng bạn phải tính cách khác thôi!
Bạn thử nghĩ xem: Công thức bạn gõ trên bảng tính, nếu chỉ 1 vài dòng không nói làm gì... Cờ chừng vài chục dòng thôi thì hơi mệt ---> Mỗi lần có thay đổi là công thức sẽ cập nhật, tức sẽ truy cập file nguồn để lấy dữ liệu, từ đó làm cho file chạy nặng nề
 
Upvote 0
Gởi mọi ngưởi,
Hôm nay tôi mới thấy cuộc tranh cãi này. Những bài bị xóa phía trên là do mod khác xóa, lý do là tranh luận lạc đề, có thể gây ra tranh cãi hoặc mất lòng nhau.
Bản thân bài của siwtom nhờ xóa, lại là 1 bài viết có giá trị về học thuật, và giọng văn không có gì là phê phán, công kích, hay bất cứ cái gì có thể đưa vào lý do xóa cả. Các góp ý về giải thuật, về bẫy lỗi, ... của siwtom trong mấy bài gần đây rất đáng để học hỏi. (Kể cả hàm Draw bên kia)
Nếu tôi là mod đó, tôi cũng vẫn xóa những bài tranh luận. Riêng bài siwtom nhờ xóa, tôi sẽ dời qua topic mà ndu đưa link.

Gởi ndu,
Không phải lúc nào lạc đề cũng xóa. Bài có giá trị thì Ban QT vẫn cân nhắc và để lại. Và, mod Hoàng Danh đã để chừa lại.

Do đó, ndu có thể đế nghị Ban QT dời bài qua topic khác, và khi siwtom đọc lời đề nghị đó sẽ không hiểu lầm cả ndu lẫn ban QT.

TB
Các bài tranh cãi chưa xóa phía trên, cũng sẽ bị xóa.

Bài của siwtom nhờ xóa, tôi sẽ dời đi. Mời siwtom và ndu qua đó thảo luận để hoàn thiện lại hàm đó.
 
Upvote 0
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

C
  • Question
Tạo schedule chạy code VBA
Trả lời
1
Đọc
42
quick87
quick87
son0611excel
  • Question
VBA tra cứu hình theo điều kiện
Trả lời
3
Đọc
42
Hoàng Tuấn 868
H
P
  • Question
anh em cho em xin code vba với, em xin cám ơn
Trả lời
2
Đọc
50
phantu93
P
LuuAnh980
  • Question
Code lấy dữ liệu từ 3 file con.
2 3 4
Trả lời
76
Đọc
1K
ptm0412
ptm0412
P
anh em cho em xin code vba với
Trả lời
0
Đọc
36
phantu93
P
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom