0905744404
Thành viên thường trực
- Tham gia
- 26/10/10
- Bài viết
- 333
- Được thích
- 107
- Nghề nghiệp
- Trước là : Thủ Kho - còn giờ thì :"Tài Xế"
Em nhờ mọi cả nhà giúp em viết code chuyển từ hàm Vlookup() sang Code VBA
Thay Code cho hàm Vlookup() (3 người xem)
- Thread starter 0905744404
- Ngày gửi
Người dùng đang xem chủ đề này
Thành viên thường trực
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,958
Tôi nghĩ kết quả trả về là lỗi N/A mới đúng
Thêm nữa: Dùng End(xlDown) nguy hiểm quá! Xóa vùng F2:F11 thì code chạy... "mút chỉ" luôn. Còn xóa cell nào đó ở giữa thì.. Ẹc... Ẹc...
(Khi viết code, tôi ghét nhất là thằng End(...)... cứ chọn vùng dữ liệu dư ra một chút là được rồi)
------------------------------
Các bạn thử viết thành 1 Function xem sao (thay vì Sub)
Upvote
0
doveandrose
hello
- Tham gia
- 3/7/09
- Bài viết
- 2,372
- Được thích
- 2,263
giá trị có nhìn thấy trên bảng lý do gì trả về N/A vậy thầy ?
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,958
Ví dụ thế này:
TÊN KH..... MUA HÀNG
KH A ..... Thịt heo
KH B ..... Cá
KH A ..... Rau
KH B ..... Dầu gội đầu
KH A ..... Kem đánh răng
.......
Đại khái thế! Vậy khi hỏi "Sản phẩm mà KH A mua lần 3 là gì?" ta đương nhiên sẽ trả lời "kem đánh răng". Đúng chứ?
Nhưng khi hỏi "Sản phẩm mà KH A mua lần 4 là gì?" ta trả lời sao?
------------------------
Đương nhiên chỉ là quan điểm cả nhân của tôi thôi. Các bạn làm sao cũng được. Đàng nào thuật toán vẫn quan trọng hơn!
Upvote
0
Let'GâuGâu
Thành viên mới
- Tham gia
- 12/9/13
- Bài viết
- 3,131
- Được thích
- 2,732
àh vâng, tôi ko lường hết các trường hợp, trường hợp này phải để trống hoặc trả về N/A
tôi đọc code bạn tôi cũng không nắm vững cách bạn gán item
ở cái Dic temkey, mỗi key bạn gán nhiều item? có phải vậy ko
==========
bạn thử dùng 2 dictionary xem
Upvote
0
Phuocam
Thành viên mới
- Tham gia
- 16/5/13
- Bài viết
- 4,732
- Được thích
- 7,747
Xin góp một bài, code chưa bẫy lỗi, hehehe!
Mã:
Public Function FLOOKUP(TriDo As Variant, BangDo As Range, Cot As Long, Lan As Long) As String
Dim i As Long, k As Long, Tam()
For i = 1 To BangDo.Rows.Count
If TriDo = BangDo(i, 1).Value Then
k = k + 1
ReDim Preserve Tam(1 To k)
Tam(k) = BangDo(i, Cot).Value
End If
Next i
If Lan > 0 And Lan <= k Then FLOOKUP = Tam(Lan)
End Function
Upvote
0
Let'GâuGâu
Thành viên mới
- Tham gia
- 12/9/13
- Bài viết
- 3,131
- Được thích
- 2,732
không được bạn, vậy là ăn gian.........heheheheh
tôi muốn F2="nguyen van muoi hai"
tới F10 mới nguyên văn mười hai lần thứ 2
không liên tục
Upvote
0
Let'GâuGâu
Thành viên mới
- Tham gia
- 12/9/13
- Bài viết
- 3,131
- Được thích
- 2,732
à, tôi thấy bạn sử dụng 2 cái dic rồi....heheheh
tôi hơi bị bối rối bởi đoạn code
Mã:
dic(tempKey)(r) = sArr(r, 2)==============
góp thêm với bạn một cách tôi làm bằng dic
Mã:
Sub VlookupMultipleValue()
Dim ng, dich, tam As Variant, i, j, k As Long, Dng, Ddich As Object
ng = [a2].Resize([a60000].End(3).Row, 2)
dich = [f2].Resize([f60000].End(3).Row, 2)
Set Dng = CreateObject("Scripting.Dictionary")
Set Ddich = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(ng)
If Not Dng.Exists(ng(i, 1)) Then
Dng.Add ng(i, 1), ng(i, 2)
Else
Dng.Item(ng(i, 1)) = Dng.Item(ng(i, 1)) & "," & ng(i, 2)
End If
Next
For i = 1 To UBound(dich)
If Dng.Exists(dich(i, 1)) Then
If Not Ddich.Exists(dich(i, 1)) Then
Ddich.Add dich(i, 1), 0
Else
Ddich.Item(dich(i, 1)) = Ddich.Item(dich(i, 1)) + 1
End If
tam = Split(Dng.Item(dich(i, 1)), ",")
For j = 0 To UBound(tam)
If j = Ddich.Item(dich(i, 1)) Then dich(i, 2) = tam(j): Exit For
Next
End If
Next
[f2].Resize([f60000].End(3).Row, 2) = dich
End Sub
Upvote
0
doveandrose
hello
- Tham gia
- 3/7/09
- Bài viết
- 2,372
- Được thích
- 2,263
bạn nói thế là bạn chưa hiểu đoạn code của t . t cũng ko cần ai hiểu code của mình , đối với t miễn sao bấm nút có chạy là được
ta không bàn đến những lỗi lặt vặt . ta chỉ nói đến ý tưởng
code của t dùng rất nhiều dictionary , mỗi item của dic cha lại là 1 dictionary con bởi vì t không biết liệu dữ liệu cần dò là số hay chuỗi (như ở #44 đã nêu chẳng hạn )
nếu chắc chắn dữ liệu cần dò là numeric thì có thể xài nối chuỗi bằng "," như bạn
nếu bạn hiểu code của t thì bạn sẽ rút kinh nghiệm cho code của bạn chỉ cần sử dụng 1 dictionary duy nhất mà thôi ( nghĩ xem có thể ko ?)
và việc truy lấy giá trị của item trong mảng khi đã biết index kể cả là index đó vượt ra ngoài ubound mà phải xài lặp for lại càng khó coi
Mã:
For j = 0 To UBound(tam)
If j = Ddich.Item(dich(i, 1)) Then dich(i, 2) = tam(j): Exit For
Nexttất nhiên không ai có quyền bắt bạn code thế này , code thế nọ , chúng ta chỉ góp ý xây dưng nhau mà thôi
Upvote
0
Let'GâuGâu
Thành viên mới
- Tham gia
- 12/9/13
- Bài viết
- 3,131
- Được thích
- 2,732
thật là tôi ko hiểu chứ ko phải bất bí gì bạn (vì tôi chưa thấy cách sử dụng như vậy, nói rỏ là do tôi chưa thấy chứ ko nói trên diễn đàn ko có)
tôi đâu có phải là siêu code đâu mà bắt bí..............hihihihi
chúc vui nha
Upvote
0
Let'GâuGâu
Thành viên mới
- Tham gia
- 12/9/13
- Bài viết
- 3,131
- Được thích
- 2,732
lời thật thì khó nghe
thuốc dắng thì giả tật
xin được sửa code lại như sau:
Mã:
Sub VlookupMultipleValue()
Dim ng, dich, tam As Variant, i, j, k As Long, Dng, Ddich As Object
[g2:g60000].Clear
ng = [a2].Resize([a60000].End(3).Row, 2)
dich = [f2].Resize([f60000].End(3).Row, 2)
Set Dng = CreateObject("Scripting.Dictionary")
Set Ddich = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(ng)
If Not Dng.Exists(ng(i, 1)) Then
Dng.Add ng(i, 1), ng(i, 2)
Else
Dng.Item(ng(i, 1)) = Dng.Item(ng(i, 1)) & "#" & ng(i, 2)
End If
Next
For i = 1 To UBound(dich)
If Dng.Exists(dich(i, 1)) Then
If Not Ddich.Exists(dich(i, 1)) Then
Ddich.Add dich(i, 1), 0
Else
Ddich.Item(dich(i, 1)) = Ddich.Item(dich(i, 1)) + 1
End If
tam = Split(Dng.Item(dich(i, 1)), "#")
k = Ddich.Item(dich(i, 1))
If k <= UBound(tam) Then dich(i, 2) = tam(k)
End If
Next
[f2].Resize([f60000].End(3).Row, 2) = dich
End Subđang chờ bác cho xem code
tôi nghĩ là nếu làm được như vậy thì phải làm sao mà một key add được nhiều items
suy nghĩ 2 ngày rồi vẫn chưa ra............hichic
Upvote
0
doveandrose
hello
- Tham gia
- 3/7/09
- Bài viết
- 2,372
- Được thích
- 2,263
thư giãn nào có gì căng thế
khi nào thư giãn xong bạn nhìn lại chuỗi mà bạn tạo để làm item nhé
chuỗi đó là do chính bạn tạo , và thay đổi nó để phục vụ việc của bạn cũng phải do chính bạn . chìa khóa nằm ở người viết code mà (lý thuyết quá cha ơi , nói thẳng đi )
ờ . Dng.Item(ng(i, 1)) = chuỗi
cái chuỗi đó bạn chứa luôn cái current index của array (khi split) không được sao ? cái mà bạn nhét vào ddich ấy .
khi split chuỗi Dng.Item(ng(i, 1)) ra thành array(item1,item2,...) current index cũng là 1 item nằm trong array(item1,item2,...)
item đó có giá trị nào để array không được truy xuất đến chính item đó ?
làm sao thay đổi item đó trước khi gán trả lại Dng.Item(ng(i, 1)) đặng lần sau split thì nó gọi đến item kế tiếp ?
nói thì dài nhưng cũng đâu có gì khó nhỉ
Lần chỉnh sửa cuối:
Upvote
0
concogia
Gội rồi mới Cạo
- Tham gia
- 17/9/09
- Bài viết
- 3,412
- Được thích
- 6,877
Thật tình thì bài này cũng bình thường thôi mà, có thể bạn nghĩ hơi.....cao cao nên nó "ừ ứ ư". Mình cứ "phang" kiểu "giang hồ GPE" thì thế này:
1) Chạy dữ liệu "nguồn" (tạm gọi như thế) nạp dữ liệu vào em Đít-to
2) Chạy dữ liệu "đích" (cũng....tạm gọi như thế) lôi lại dữ liệu đã nạp vào em Đít-to gán vào mảng kết quả, phang xuống sheet là....xong
Đại khái thế này ( làm theo dữ liệu trong bài của bạn, nếu có khác đi thì tùy tình hình mà sửa cho phù hợp)
Mã:
Public Sub MotDitto()
Dim Vung, Tim, d, I, Kq
Set d = CreateObject("scripting.dictionary")
Vung = Range([A2], [A50000].End(xlUp)).Resize(, 2)
Tim = Range([F2], [F50000].End(xlUp))
For I = 1 To UBound(Vung)
If Not d.exists(Vung(I, 1)) Then
d.Add Vung(I, 1), Vung(I, 2) & " "
Else
d.Item(Vung(I, 1)) = d.Item(Vung(I, 1)) & Vung(I, 2) & " "
End If
Next I
ReDim Kq(1 To UBound(Tim), 1 To 1)
For I = 1 To UBound(Tim)
If d.exists(Tim(I, 1)) Then
If Len(d.Item(Tim(I, 1))) Then
Kq(I, 1) = Left(d.Item(Tim(I, 1)), InStr(d.Item(Tim(I, 1)), " "))
d.Item(Tim(I, 1)) = Replace(d.Item(Tim(I, 1)), Kq(I, 1), "")
End If
End If
Next I
[H2].Resize(UBound(Tim)) = Kq
End Sub
Upvote
0
concogia
Gội rồi mới Cạo
- Tham gia
- 17/9/09
- Bài viết
- 3,412
- Được thích
- 6,877
Hihi, thì đã bảo
Chưa ok thì .....sửa tí tẹo ( do cách lấy dữ liệu trong Item ra thôi mà. Híc)
Mã:
Public Sub MotDitto()
Dim Vung, Tim, d, I, Kq
Set d = CreateObject("scripting.dictionary")
Vung = Range([A2], [A50000].End(xlUp)).Resize(, 2)
Tim = Range([F2], [F50000].End(xlUp))
For I = 1 To UBound(Vung)
If Not d.exists(Vung(I, 1)) Then
d.Add Vung(I, 1), Vung(I, 2) & " "
Else
d.Item(Vung(I, 1)) = d.Item(Vung(I, 1)) & Vung(I, 2) & " "
End If
Next I
ReDim Kq(1 To UBound(Tim), 1 To 1)
For I = 1 To UBound(Tim)
If d.exists(Tim(I, 1)) Then
If Len(d.Item(Tim(I, 1))) Then
Kq(I, 1) = Left(d.Item(Tim(I, 1)), InStr(d.Item(Tim(I, 1)), " "))
[I][B]d.Item(Tim(I, 1)) = Right(d.Item(Tim(I, 1)), Len(d.Item(Tim(I, 1))) - Len(Kq(I, 1)))[/B][/I]
End If
End If
Next I
[H2].Resize(UBound(Tim)) = Kq
End SubBài này chủ yếu nói về cách giải bằng 1 em Đít-to, nạp dữ liệu tuần tự vào Item, khi lấy ra cũng theo tuần tự í.
Híc
Lần chỉnh sửa cuối:
Upvote
0
sealand
Thành viên gạo cội
- Tham gia
- 16/5/08
- Bài viết
- 4,883
- Được thích
- 7,688
- Giới tính
- Nam
- Nghề nghiệp
- Kế Toán
Mình cũng góp 1 bài không dùng Dic
Mã:
Sub NoneDic()
Dim Vung, Tim, Tm, i, j
Vung = Range([A2], [A50000].End(xlUp)).Resize(, 2)
Tim = Range([F2], [F50000].End(xlUp)).Resize(, 2)
Tm = Range([A2], [A50000].End(xlUp))
On Error Resume Next
For i = 1 To UBound(Tim, 1)
j = WorksheetFunction.Match(Tim(i, 1), Tm, 0)
If Err.Number > 0 Then
Tim(i, 2) = ""
Err.Clear
Else
Tim(i, 2) = Vung(j, 2)
Vung(j, 1) = ""
End If
Next
Range([F2], [F50000].End(xlUp)).Resize(, 2) = Tim
End Sub
Upvote
0
Nếu bạn dùng hàm Match thì gọi nó trong ngữ cảnh Application, như vậy khỏi phải bẫy lỗi.
j = Application.Match(Tim(i, 1), Tm, 0)
If isnumeric(j) Then
(ở đây là vì trong code của bạn dim j là mặc định, tức là variant. Nếu code của bạn dim j là integer thì bắt buộc phải bẫy lỗi)
Upvote
0
Theo tôi thì không nên dùng một giải quyết chung cho nhiều kiểu lỗi. Rất nguy hiểm.
Nếu tôi bẫy lỗi thì loại nào hẳn hòi ra loại nấy.
On Error Resume Next
Làm cái gì đó
Select case Err.Number
case 0
case ...
case ...
Nếu tôi bẫy lỗi thì loại nào hẳn hòi ra loại nấy.
On Error Resume Next
Làm cái gì đó
Select case Err.Number
case 0
case ...
case ...
Upvote
0
Bài viết mới nhất
- Question
- Question
- Question
- Question
