Giúp đỡ hàm tìm kiếm VBA (1 người xem)

[swalowbird]

Mình đang làm một addin để thay cho Vlookup và đang gặp lỗi ở dong.offset(1,0) , mọi người giúp mình với
Đang bí chỗ tìm kiếm giữa 2 sheet , workook.

thanks !

Option Explicit

Sub offset()
Dim dong As Range
Dim rng1 As Range
Dim rng2 As Range
Dim rng As Range
Dim K As Integer

Set rng1 = Application.InputBox(Prompt:="chon vung dieu kien ", Title:="Range Select", Type:=8)

Set rng2 = Application.InputBox(Prompt:="chon vung tham chieu ", Title:="Range Select", Type:=8)



Dim sArr(), i As Long
Dim kArr(), j As Long
i = j
sArr = [rng1].Value


K = InputBox(" Nhap so cot du lieu ", " nhap k")

For i = 1 To UBound(sArr)
Set dong = rng2.Find(sArr(i, 1), , xlFormulas, xlWhole)
If Not dong Is Nothing Then
dong.offset(, K) = kArr(j)
End If
Next i

Set rng = Application.InputBox(Prompt:="chon vung tra ket qua ", Title:="Range Select", Type:=8)
rng.Select
For j = 1 To UBound(sArr)
rng.Cells(j, 1).Value = kArr(j)
Next j

End Sub

 

[PacificPR]

Mình đang làm một addin để thay cho Vlookup và đang gặp lỗi ở dong.offset(1,0) , mọi người giúp mình với
Đang bí chỗ tìm kiếm giữa 2 sheet , workook.

Bạn thử với cái này xem sao:

Sub offset()
    Dim Rng1 As Range, Rng2 As Range, Rng As Range
    Dim N As Integer, K As Long, I As Long, Cot As Long, hang As Long
    Dim sArr(), dArr(1 To 65535, 1 To 1), tArr()
On Error GoTo 1
Set Rng1 = Application.InputBox(Prompt:="chon vung dieu kien (Vung co nhieu hang va 1 cot)", Title:="Chon dung dieu kien", Type:=8)
Set Rng2 = Application.InputBox(Prompt:="chon vung tham chieu  ", Title:="Vung tham chieu", Type:=8)
sArr = Rng1.Value
N = InputBox(" Nhap so N la STT cot do tim trong vung tham chieu ", " Nhap so N")
For I = 1 To UBound(sArr)
    K = K + 1
   On Error Resume Next
    dArr(K, 1) = Rng2.Find(sArr(I, 1)).offset(, N - 1)
Next I
Set Rng = Application.InputBox(Prompt:="chon o gan ket qua ", Title:="Range Select", Type:=8)
Cot = Rng.Column: hang = Rng.Row
Cells(hang, Cot).Resize(1000, 1).ClearContents
Cells(hang, Cot).Resize(K, 1) = dArr
1: Exit Sub
End Sub

Hoặc

Public Sub TimKiem()
    Dim Dic As Object, sArr(), tArr(), dArr(1 To 65535, 1 To 1)
    Dim i As Long, N As Long, k As Long, Cot As Long, hang As Long
    Dim Tem As String
    Set Dic = CreateObject("Scripting.Dictionary")
    On Error GoTo 1
    Set Rng1 = Application.InputBox(Prompt:="chon vung dieu kien (Vung co nhieu hang va 1 cot)", Title:="Chon dung dieu kien", Type:=8)
    Set Rng2 = Application.InputBox(Prompt:="chon vung tham chieu  ", Title:="Vung tham chieu", Type:=8)
    N = InputBox(" Nhap so N la STT cot do tim trong vung tham chieu ", " Nhap so N")
    sArr = Rng1.Value: tArr = Rng2.Value
    For i = 1 To UBound(tArr, 1)
        Dic.Item(tArr(i, 1)) = i
    Next i
    For i = 1 To UBound(sArr, 1)
        Tem = sArr(i, 1)
        k = k + 1
        On Error Resume Next
        dArr(k, 1) = tArr(Dic.Item(Tem), N)
    Next i
    Set Rng = Application.InputBox(Prompt:="chon o gan ket qua ", Title:="Range Select", Type:=8)
    Cot = Rng.Column: hang = Rng.Row
    Cells(hang, Cot).Resize(1000, 1).ClearContents
    Cells(hang, Cot).Resize(k, 1) = dArr
    Set Dic = Nothing
1:          Exit Sub
End Sub

 

[swalowbird]

Thank bác nhé ! Bác có cách nào áp dụng cả cho workbook khác đang mở không ?

Giúp em cái

thanks !

 

[swalowbird]

Nhưng mình thấy có vấn đề ở đây là :
Nếu vùng điều kiện là 1 ô thì không thể tìm được
?

 

[SA_DQ]

Mấy macro trên chưa phải là hàm người dùng;

Nếu biết được í đồ tác giả ta có thể chuyển macro thành hàm người dùng (UDF) & khi đó xài đâu cũng được!

Option Explicit
Sub offset()
Dim Dong As Range, RgDK As Range, RgTC As Range, Rng As Range
Dim sArr(), kArr()
Dim K As Integer, I As Long, J As Long
Const CV As String = "Chon Vùng "
Const RS As String = "Range Select"

1 Set RgDK = Application.InputBox(Prompt:=CV & "dieu kien ", Title:=RS, Type:=8)
2 Set RgTC = Application.InputBox(Prompt:=CV & "tham chieu ", Title:=RS, Type:=8)
I = J
sArr = [RgDK].Value
K = InputBox(" Nhap so cot du lieu ", " nhap k")
For I = 1 To UBound(sArr)
    Set Dong = RgTC.Find(sArr(I, 1), , xlFormulas, xlWhole)
    If Not Dong Is Nothing Then
        Dong.offset(, K) = kArr(J)
    End If
Next I
Set Rng = Application.InputBox(Prompt:=CV & "tra ket qua ", Title:=RS, Type:=8)
Rng.Select
For J = 1 To UBound(sArr)
    Rng.Cells(J, 1).Value = kArr(J)
Next J
End Sub

(Code viết vầy có dễ đọc hơn không?)

 

[PacificPR]

Nhưng mình thấy có vấn đề ở đây là :
Nếu vùng điều kiện là 1 ô thì không thể tìm được
?

Nếu vùng điều kiện là 1 ô thì lúc đó sArr không phải là mảng nữa.
Vì mình chỉ lấy sArr(i,1) thôi thì mình khai gian nó như thế này sArr = Rng1.Resize(, 2).Value xem có được không

 

[PacificPR]

Hai anh phulien1902,
quanluu1989 góp ý cho em học hỏi thêm với

 

[swalowbird]

Bác có thể nói rõ hơn về UDF được ko ?

Vấn đề đầu tiên như em đã nói như trên (ko dùng cho 1 ô )
Vấn đề thứ 2 là không dùng cho được cho 2 workbook khác nhau ? có cách nào dùng dc 2 work book khác nhau không nhỷ ?

thanks !