Xin viết dùng mã vba thay thế cho hàm vlookup

hoangvinh_tb

Thành viên mới
Tham gia ngày
16 Tháng sáu 2008
Bài viết
20
Được thích
4
Điểm
665
Tuổi
38
Mình gửi vd lên nhờ các bắc bớt chút thời gian chỉ dùm vài chiêu
Cảm ơn các bạn nhiều!!!
 

File đính kèm

concogia

Gội rồi mới Cạo
Tham gia ngày
17 Tháng chín 2009
Bài viết
3,289
Được thích
6,581
Điểm
860
Mình gửi vd lên nhờ các bắc bớt chút thời gian chỉ dùm vài chiêu
Cảm ơn các bạn nhiều!!!
Mã nó đây
RightClick vào sheet "CT" ==> View Code chép cái này vào
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim d, I, Vung, Ws
    Set d = CreateObject("scripting.dictionary")
    Set Ws = Sheets("MA")
    Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 3)
        If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
            If Target.Count = 1 Then
                For I = 1 To UBound(Vung)
                    d.Add Vung(I, 1), Array(Vung(I, 2), Vung(I, 3))
                Next I
                    If d.exists(UCase(Target.Value)) Then
                        Target.Offset(, 1) = d.Item(UCase(Target.Value))(0)
                        Target.Offset(, 2) = d.Item(UCase(Target.Value))(1)
                    End If
            End If
         End If
End Sub
Thân
 

SA_DQ

/(hông là gì!
Thành viên danh dự
Tham gia ngày
8 Tháng sáu 2006
Bài viết
11,844
Được thích
17,762
Điểm
1,860
Cái ni cũng vừa đủ sòai nề

PHP:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("B4:B99")) Is Nothing Then
    Dim Rng As Range, sRng As Range, Sh As Worksheet
    
    Set Sh = ThisWorkbook.Worksheets("MA")
    Set Rng = Sh.Range(Sh.[b2], Sh.[b2].End(xlDown))
    Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
    If sRng Is Nothing Then
        MsgBox "Nothing"
    Else
        Target.Offset(, 1).Resize(, 2).Value = sRng.Offset(, 1).Resize(, 2).Value
    End If
 End If
End Sub
 

hoangvinh_tb

Thành viên mới
Tham gia ngày
16 Tháng sáu 2008
Bài viết
20
Được thích
4
Điểm
665
Tuổi
38
Cám ơn bạn đã gửi cho mình đoạn mã này! nhưng mình muốn triển khai đoạn mã đó mà vẫn chưa làm đc mong bạn giải thích và giúp mình nhé
Mình muốn cột địa chỉ di chuyển các cột tên khoảng 5 cột
 

TrungChinhs

Thành viên tích cực
Tham gia ngày
18 Tháng hai 2008
Bài viết
1,478
Được thích
2,456
Điểm
860
Nơi ở
Mường La, Sơn La
Cám ơn bạn đã gửi cho mình đoạn mã này! nhưng mình muốn triển khai đoạn mã đó mà vẫn chưa làm đc mong bạn giải thích và giúp mình nhé
Mình muốn cột địa chỉ di chuyển các cột tên khoảng 5 cột
5 cột ấy là những cột nào vậy bạn ? Nhiều người trên diễn đàn (trong đó có tôi) cho rằng hỏi bài mà không gửi file đính kèm và không diễn đạt rõ yêu cầu là thiếu trách nhiệm với câu hỏi của mình và thiếu tôn trọng người mình hỏi.
 

hoangvinh_tb

Thành viên mới
Tham gia ngày
16 Tháng sáu 2008
Bài viết
20
Được thích
4
Điểm
665
Tuổi
38
5 cột ấy là những cột nào vậy bạn ? Nhiều người trên diễn đàn (trong đó có tôi) cho rằng hỏi bài mà không gửi file đính kèm và không diễn đạt rõ yêu cầu là thiếu trách nhiệm với câu hỏi của mình và thiếu tôn trọng người mình hỏi.
cám ơn bạn đã góp chân thành mình cũng định gửi file đính kèm mà không có cách nào đính kèm đc mong bạn và các bạn trong diễn đàn thông cảm.
 

khongphai02

Thành viên mới
Tham gia ngày
7 Tháng tư 2012
Bài viết
15
Được thích
1
Điểm
365
Mã nó đây
RightClick vào sheet "CT" ==> View Code chép cái này vào
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim d, I, Vung, Ws
    Set d = CreateObject("scripting.dictionary")
    Set Ws = Sheets("MA")
    Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 3)
        If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
            If Target.Count = 1 Then
                For I = 1 To UBound(Vung)
                    d.Add Vung(I, 1), Array(Vung(I, 2), Vung(I, 3))
                Next I
                    If d.exists(UCase(Target.Value)) Then
                        Target.Offset(, 1) = d.Item(UCase(Target.Value))(0)
                        Target.Offset(, 2) = d.Item(UCase(Target.Value))(1)
                    End If
            End If
         End If
End Sub
Thân
Mình cũng đang cần cái này, cảm ơn pro. cái này hay lắm. Mình làm cửa hàng bán lẻ, hằng ngày phải xuất kho tương đối nhiều phiếu giao hàng trong 1 thời gian ngắn. Dùng hàm vlookup file excel lên đến 150MB nhìn đã thấy khiếp. đang tìm mã vba để thay thế vlookup. Thank pro nhé.
 

qtm1987

Thành viên hoạt động
Tham gia ngày
15 Tháng chín 2009
Bài viết
108
Được thích
47
Điểm
670
Tuổi
33
Nơi ở
Đà Lạt
Mã nó đây
RightClick vào sheet "CT" ==> View Code chép cái này vào
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim d, I, Vung, Ws
    Set d = CreateObject("scripting.dictionary")
    Set Ws = Sheets("MA")
    Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 3)
        If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
            If Target.Count = 1 Then
                For I = 1 To UBound(Vung)
                    d.Add Vung(I, 1), Array(Vung(I, 2), Vung(I, 3))
                Next I
                    If d.exists(UCase(Target.Value)) Then
                        Target.Offset(, 1) = d.Item(UCase(Target.Value))(0)
                        Target.Offset(, 2) = d.Item(UCase(Target.Value))(1)
                    End If
            End If
         End If
End Sub
Thân
code này hay, lâu nay mình lại dùng 2 vòng for hèn gì mà khi dữ liệu nhiều thì tìm kiếm lâu lắc.
==============================================
Sau khi thử code trên mình thấy chỉ tìm kiếm được cho từng mã khi click vào ô đó (tức là nhập vào giá trị mã cho ô đó thì sẽ tìm kiếm cho mã tại ô đó). Vậy nếu mình có sẵn 1 danh sách mã và muốn tìm kiếm cho 1 danh sách mã đó thì ko lẽ phải click từng mã mới tìm kiếm được. Mình vẫn phải dùng 2 vòng For, 1 vòng for cho vùng chứa dữ liệu tìm kiếm và 1 vòng for cho vùng chứa mã muốn tìm kiếm. Với cách này dữ liệu hàng chục ngàn dòng thì code chạy lâu, có cách nào khác không nhỉ?
PHP:
Sub TimKiem_Vlookup()
Dim i As Long, j As Long, sArray1, sArray2, Arr()
With Sheets("MA")
    sArray1 = .Range(.[B3], .[B65000].End(xlUp)).Resize(, 3).Value
End With
With Sheets("CT")
    .Range("C4:D65000").ClearContents
    sArray2 = .Range(.[B4], .[B65000].End(xlUp)).Value
    ReDim Arr(1 To UBound(sArray2, 1), 1 To 2)
For j = 1 To UBound(sArray2, 1)
    For i = 1 To UBound(sArray1, 1)
        If Not IsEmpty(sArray2(j, 1)) And sArray1(i, 1) = UCase(sArray2(j, 1)) Then
            Arr(j, 1) = sArray1(i, 2)
            Arr(j, 2) = sArray1(i, 3)
        End If
    Next
Next
.Range("C4").Resize(j - 1, 2).Value = Arr
End With
End Sub
 
Lần chỉnh sửa cuối:

khongphai02

Thành viên mới
Tham gia ngày
7 Tháng tư 2012
Bài viết
15
Được thích
1
Điểm
365
Sửa giúp em cái này với Bác 'CONCOGIA'

Mã nó đây
RightClick vào sheet "CT" ==> View Code chép cái này vào
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim d, I, Vung, Ws
    Set d = CreateObject("scripting.dictionary")
    Set Ws = Sheets("MA")
    Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 3)
        If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
            If Target.Count = 1 Then
                For I = 1 To UBound(Vung)
                    d.Add Vung(I, 1), Array(Vung(I, 2), Vung(I, 3))
                Next I
                    If d.exists(UCase(Target.Value)) Then
                        Target.Offset(, 1) = d.Item(UCase(Target.Value))(0)
                        Target.Offset(, 2) = d.Item(UCase(Target.Value))(1)
                    End If
            End If
         End If
End Sub
Thân
Chào bác concogia và các cao thủ.
EM đang cần làm 1 cái phiếu xuất kho cũng thay thế hàm vlookup bằng mã VBA, copy mã của bác concogia về chạy thử thì rất ok. Chỉ có điều em muốn link thêm giá trị từ Sheet 'MA' sang sheet 'CT', mà ko biết sửa thế nào nhờ bác concogia và các cao thủ sử giúp. Em xin cảm ơn các bác.
 

File đính kèm

concogia

Gội rồi mới Cạo
Tham gia ngày
17 Tháng chín 2009
Bài viết
3,289
Được thích
6,581
Điểm
860
code này hay, lâu nay mình lại dùng 2 vòng for hèn gì mà khi dữ liệu nhiều thì tìm kiếm lâu lắc.
==============================================
Sau khi thử code trên mình thấy chỉ tìm kiếm được cho từng mã khi click vào ô đó (tức là nhập vào giá trị mã cho ô đó thì sẽ tìm kiếm cho mã tại ô đó). Vậy nếu mình có sẵn 1 danh sách mã và muốn tìm kiếm cho 1 danh sách mã đó thì ko lẽ phải click từng mã mới tìm kiếm được. Mình vẫn phải dùng 2 vòng For, 1 vòng for cho vùng chứa dữ liệu tìm kiếm và 1 vòng for cho vùng chứa mã muốn tìm kiếm. Với cách này dữ liệu hàng chục ngàn dòng thì code chạy lâu, có cách nào khác không nhỉ?
PHP:
Sub TimKiem_Vlookup()
Dim i As Long, j As Long, sArray1, sArray2, Arr()
With Sheets("MA")
    sArray1 = .Range(.[B3], .[B65000].End(xlUp)).Resize(, 3).Value
End With
With Sheets("CT")
    .Range("C4:D65000").ClearContents
    sArray2 = .Range(.[B4], .[B65000].End(xlUp)).Value
    ReDim Arr(1 To UBound(sArray2, 1), 1 To 2)
For j = 1 To UBound(sArray2, 1)
    For i = 1 To UBound(sArray1, 1)
        If Not IsEmpty(sArray2(j, 1)) And sArray1(i, 1) = UCase(sArray2(j, 1)) Then
            Arr(j, 1) = sArray1(i, 2)
            Arr(j, 2) = sArray1(i, 3)
        End If
    Next
Next
.Range("C4").Resize(j - 1, 2).Value = Arr
End With
End Sub
Code trên là viết theo đề bài của bạn hoangvinh_tb, còn nếu theo ý của bạn thì ta vẫn viết theo cách cũ + một vòng lặp For ...... Next nữa, tức là một vòng tạo Dictionary, một vòng lấy mảng kết quả
Cách của bạn là 2 vòng ......lồng vào nhau, dữ liệu càng lớn thì tốc độ càng của nó làm bạn........."hao thuốc lá + cà phê đá"
Mình chỉ nghĩ thế thôi ( trên lý thuyết) vì không có file thực tế để thử ( làm biếng tạo file quá )
Thân
 

concogia

Gội rồi mới Cạo
Tham gia ngày
17 Tháng chín 2009
Bài viết
3,289
Được thích
6,581
Điểm
860
Chào bác concogia và các cao thủ.
EM đang cần làm 1 cái phiếu xuất kho cũng thay thế hàm vlookup bằng mã VBA, copy mã của bác concogia về chạy thử thì rất ok. Chỉ có điều em muốn link thêm giá trị từ Sheet 'MA' sang sheet 'CT', mà ko biết sửa thế nào nhờ bác concogia và các cao thủ sử giúp. Em xin cảm ơn các bác.
Bạn chép code này đè lên cái cũ nhé
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim d, I, Vung, Ws
    Set d = CreateObject("scripting.dictionary")
    Set Ws = Sheets("MA")
    Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 4)
        If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
            If Target.Count = 1 Then
                For I = 1 To UBound(Vung)
                    d.Add Vung(I, 1), Array(Vung(I, 2), Vung(I, 3), Vung(I, 4))
                Next I
                    If d.exists(UCase(Target.Value)) Then
                        Target.Offset(, 1) = d.Item(UCase(Target.Value))(0)
                        Target.Offset(, 2) = d.Item(UCase(Target.Value))(1)
                        Target.Offset(, 5) = d.Item(UCase(Target.Value))(2)
                    End If
            End If
         End If
End Sub
Thân
 

khongphai02

Thành viên mới
Tham gia ngày
7 Tháng tư 2012
Bài viết
15
Được thích
1
Điểm
365
Chào bác concogia và các cao thủ.
EM đang cần làm 1 cái phiếu xuất kho cũng thay thế hàm vlookup bằng mã VBA, copy mã của bác concogia về chạy thử thì rất ok. Chỉ có điều em muốn link thêm giá trị từ Sheet 'MA' sang sheet 'CT', mà ko biết sửa thế nào nhờ bác concogia và các cao thủ sử giúp. Em xin cảm ơn các bác.
m mò ra rồi, Cảm ơn các bác nhiều...
Private Sub Worksheet_Change(ByVal Target As Range)
Dim d, I, Vung, Ws
Set d = CreateObject("scripting.dictionary")
Set Ws = Sheets("MA")
Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 4)
If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
If Target.Count = 1 Then
For I = 1 To UBound(Vung)
d.Add Vung(I, 1), Array(Vung(I, 2), Vung(I, 3), Vung(I, 4))
Next I
If d.exists(UCase(Target.Value)) Then
If d.exists(UCase(Target.Value)) Then
Target.Offset(, 1) = d.Item(UCase(Target.Value))(0)
Target.Offset(, 2) = d.Item(UCase(Target.Value))(1)
Target.Offset(, 5) = d.Item(UCase(Target.Value))(2)
End If
End If
End If
End If
End Sub
Các bác chỉ giúp em với xem có sai ko/ thanks
 

siwtom

Thành viên gắn bó
Tham gia ngày
19 Tháng ba 2008
Bài viết
2,128
Được thích
4,191
Điểm
860
Bạn chép code này đè lên cái cũ nhé
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim d, I, Vung, Ws
    Set d = CreateObject("scripting.dictionary")
    Set Ws = Sheets("MA")
    Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 4)
        If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
            If Target.Count = 1 Then
                For I = 1 To UBound(Vung)
                    d.Add Vung(I, 1), Array(Vung(I, 2), Vung(I, 3), Vung(I, 4))
                Next I
                    If d.exists(UCase(Target.Value)) Then
                        Target.Offset(, 1) = d.Item(UCase(Target.Value))(0)
                        Target.Offset(, 2) = d.Item(UCase(Target.Value))(1)
                        Target.Offset(, 5) = d.Item(UCase(Target.Value))(2)
                    End If
            End If
         End If
End Sub
Thân
Tôi thấy có vẻ nhiều người hơi lạm dụng Dictionary. Dictionary mạnh và không dễ thay thế được trong một vài trường hợp không có nghĩa là nó tốt cho mọi trường hợp. Tỏi nếu nấu với món "này" thì tuyệt nhưng không có nghĩa là nấu món nào cũng cho tỏi. Không phải mổ trâu, lợn, gà, bóc tỏi, gọt táo đều dùng dao mổ trâu. Lợi thì chắc không mà hại thì nhiều.
Sửa một chút code trên thành

Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim I, Vung, Ws
    Set Ws = Sheets("MA")
    Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 4)
    If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
        If Target.Count = 1 Then
            For I = 1 To UBound(Vung)
                If Vung(I, 1) = Ucase(Target.Value) Then
                    Target.Offset(, 1) = Vung(I, 2)
                    Target.Offset(, 2) = Vung(I, 3)
                    Target.Offset(, 5) = Vung(I, 4)
                    Exit For
                End If
            Next I
        End If
    End If
End Sub
nếu tôi không lầm thì code tốt hơn. Trong trường hợp xấu nhất thì cũng chỉ phải duyệt (FOR) tất cả các dòng của Vung, còn trong trường hợp tốt nhất thì chỉ duyệt có 1 dòng. Dùng Dictionary như trên luôn phải duyệt tất cả các dòng, rồi với mỗi dòng đó làm "động tác" d.Add ... (thừa)
Nếu số dòng không phải là "vài" mà là "mấy trăm" (mã không phải là A --> Z mà là vd. wxyz) thì chắc chắn code dùng Dictionary như trên sẽ làm nhiều việc hơn, lâu hơn.
 

tiendo1988

Thành viên chính thức
Tham gia ngày
6 Tháng tám 2009
Bài viết
82
Được thích
9
Điểm
670
Tôi thấy có vẻ nhiều người hơi lạm dụng Dictionary. Dictionary mạnh và không dễ thay thế được trong một vài trường hợp không có nghĩa là nó tốt cho mọi trường hợp. Tỏi nếu nấu với món "này" thì tuyệt nhưng không có nghĩa là nấu món nào cũng cho tỏi. Không phải mổ trâu, lợn, gà, bóc tỏi, gọt táo đều dùng dao mổ trâu. Lợi thì chắc không mà hại thì nhiều.
Sửa một chút code trên thành

Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim I, Vung, Ws
    Set Ws = Sheets("MA")
    Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 4)
    If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
        If Target.Count = 1 Then
            For I = 1 To UBound(Vung)
                If Vung(I, 1) = Ucase(Target.Value) Then
                    Target.Offset(, 1) = Vung(I, 2)
                    Target.Offset(, 2) = Vung(I, 3)
                    Target.Offset(, 5) = Vung(I, 4)
                    Exit For
                End If
            Next I
        End If
    End If
End Sub
nếu tôi không lầm thì code tốt hơn. Trong trường hợp xấu nhất thì cũng chỉ phải duyệt (FOR) tất cả các dòng của Vung, còn trong trường hợp tốt nhất thì chỉ duyệt có 1 dòng. Dùng Dictionary như trên luôn phải duyệt tất cả các dòng, rồi với mỗi dòng đó làm "động tác" d.Add ... (thừa)
Nếu số dòng không phải là "vài" mà là "mấy trăm" (mã không phải là A --> Z mà là vd. wxyz) thì chắc chắn code dùng Dictionary như trên sẽ làm nhiều việc hơn, lâu hơn.
Mặc dừ tôi chưa biết sử dụng các code lệnh xong tôi xin có vài ý kiến để các bác xem xét:
tôi thấy code của siwtom và code của concogia đều ngắn gọn và đã đáp ứng được việc hiển thị thông tin trong các cột Sản phẩm, đơn vị, đơn giá khi nhập mã vào cột MA ở Sheet CT.
Xong khi ta xóa các mã ở một dòng bất kỳ thì trên cột MA thì những thông tin ở các cột bên vẫn còn nguyên không bị mất.
Các Pro có thể bổ sung thêm để đáp ứng yêu cầu khi xóa trên cột MA thì các thông tin về tên sản phẩm, đơn vị, đơn giá cùng biến mất.

Các Pro thông thạo về VBA bớt chút thời gian giúp em Topic Trợ giúp CODE VBA để thay thế cho hàm Vlookup
 
Lần chỉnh sửa cuối:

qtm1987

Thành viên hoạt động
Tham gia ngày
15 Tháng chín 2009
Bài viết
108
Được thích
47
Điểm
670
Tuổi
33
Nơi ở
Đà Lạt
....
Xong khi ta xóa các mã ở một dòng bất kỳ thì trên cột MA thì những thông tin ở các cột bên vẫn còn nguyên không bị mất.
Các Pro có thể bổ sung thêm để đáp ứng yêu cầu khi xóa trên cột MA thì các thông tin về tên sản phẩm, đơn vị, đơn giá cùng biến mất.
Bạn có thể thêm đoạn code màu đỏ này vào code của bạn Concogia, cách làm tương tự nếu bạn muốn xóa thêm phần nào đó cho mã đó.
....
If d.exists(UCase(Target.Value)) Then
Target.Offset(, 1) = d.Item(UCase(Target.Value))(0)
Target.Offset(, 2) = d.Item(UCase(Target.Value))(1)
ElseIf IsEmpty(Target) Then
Target.Offset(, 1) = ""
Target.Offset(, 2) = ""

End If
...
 

tiendo1988

Thành viên chính thức
Tham gia ngày
6 Tháng tám 2009
Bài viết
82
Được thích
9
Điểm
670
Em đã thử thêm Code của Ban qtm1987 vào đoạn code của concogia theo hướng dẫn. Kết quả rất tốt.
Em mới tiếp cận đến code nên chưa hiểu gì nhiều về các code sử dụng.
Làm phiền các bác giải thích giúp em ý nghĩa của những code mà anh qtm1987 concogia đã sử dụng để em hiểu hơn về code và có thể tùy biến vào bài của mình.
Xin cảm ơn!
 

khongphai02

Thành viên mới
Tham gia ngày
7 Tháng tư 2012
Bài viết
15
Được thích
1
Điểm
365
Bạn chép code này đè lên cái cũ nhé
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim d, I, Vung, Ws
    Set d = CreateObject("scripting.dictionary")
    Set Ws = Sheets("MA")
    Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 4)
        If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
            If Target.Count = 1 Then
                For I = 1 To UBound(Vung)
                    d.Add Vung(I, 1), Array(Vung(I, 2), Vung(I, 3), Vung(I, 4))
                Next I
                    If d.exists(UCase(Target.Value)) Then
                        Target.Offset(, 1) = d.Item(UCase(Target.Value))(0)
                        Target.Offset(, 2) = d.Item(UCase(Target.Value))(1)
                        Target.Offset(, 5) = d.Item(UCase(Target.Value))(2)
                    End If
            End If
         End If
End Sub
Thân
Chào bác 'concogia', em đã làm theo cách của bác, file excel của em chạy rất ổn, dung lượng file giảm từ 150MB xuống còn 24MB, quá tuyệt luôn. File nhanh, tuy nhiên em gặp một số vấn đề cần bác phát triển thêm giúp em.
- Thứ nhất: Khi xóa mã ở Shet ‘CT’ thì các giá trị ‘Tên sp’; ‘ĐVT’, ‘Đơn giá’ vẫn giữ nguyên. (như bác ‘tiendo1988’ đã thắc mắc – bác ‘qtm1987’ đã bổ sung)
- Thứ hai: Làm thế nào để khi thay đổi giá trị đơn giá ở Sheet ‘MA’ thì bên sheet CT sẽ tự động cập nhập đơn giá mới?
Mong bác 'concogia', bác ‘qtm1987’ và các bác cao thủ giải quyết vấn đề này giúp em với.
Thank các bác nhiều!
 
Lần chỉnh sửa cuối:

khongphai02

Thành viên mới
Tham gia ngày
7 Tháng tư 2012
Bài viết
15
Được thích
1
Điểm
365
Bạn có thể thêm đoạn code màu đỏ này vào code của bạn Concogia, cách làm tương tự nếu bạn muốn xóa thêm phần nào đó cho mã đó.
....
If d.exists(UCase(Target.Value)) Then
Target.Offset(, 1) = d.Item(UCase(Target.Value))(0)
Target.Offset(, 2) = d.Item(UCase(Target.Value))(1)
ElseIf IsEmpty(Target) Then
Target.Offset(, 1) = ""
Target.Offset(, 2) = ""

End If
...
Em đã thử cách của bác nhưng khi thao tác xóa từng ô thì các giá trị ở cột sản phẩm, đơn vị, đơn giá cũng mất. nhưng nếu quét nhiều ô để xóa thì các giá trị khác vẫn giữ nguyên. làm thế nào để khi quét nhiều ô để xóa thì các giá trị khác cũng bị xóa hả bác 'qtm1987'
 

ndu96081631

Huyền thoại GPE
Thành viên BQT
Super Moderator
Tham gia ngày
5 Tháng sáu 2008
Bài viết
30,659
Được thích
53,399
Điểm
11,910
Em đã thử cách của bác nhưng khi thao tác xóa từng ô thì các giá trị ở cột sản phẩm, đơn vị, đơn giá cũng mất. nhưng nếu quét nhiều ô để xóa thì các giá trị khác vẫn giữ nguyên. làm thế nào để khi quét nhiều ô để xóa thì các giá trị khác cũng bị xóa hả bác 'qtm1987'
Đây là thiếu sót của tất cả các code từ đầu topic đến giờ
Dùng sự kiện Worksheet_Change phải biết rằng Target không phải luôn là 1 cell ---> Đôi khi ngươi ta copy/paste( hoặc quét chọn khối cell rồi Delete như bạn làm) thì sao?
Chính vì thế phải cho thêm công đoạn quét toàn bộ các cell thuộc Target (For Each Clls in Target chẳng hạn)
Nói chung dạng bài này cũng đã từng post trên diễn đàn rồi... nếu khéo léo, có thể dùng Array để tăng tốc bảng tính
Các bạn khác đang nghiên cứu về VBA code thừ cải tiến lại xem
(tôi làm hoài dạng này đâm chán luôn)
--------------------------------------
Tôi thấy có vẻ nhiều người hơi lạm dụng Dictionary. Dictionary mạnh và không dễ thay thế được trong một vài trường hợp không có nghĩa là nó tốt cho mọi trường hợp. Tỏi nếu nấu với món "này" thì tuyệt nhưng không có nghĩa là nấu món nào cũng cho tỏi. Không phải mổ trâu, lợn, gà, bóc tỏi, gọt táo đều dùng dao mổ trâu. Lợi thì chắc không mà hại thì nhiều.
Sửa một chút code trên thành
.
Đây chính là lúc dùng đến Dictionary nè!
Tuy nhiên, nếu khéo hơn thì ta chỉ tạo và nạp Dictionary 1 lần duy nhất (nếu Dictionary chưa được tạo) ---> Những lần sau đó của sự kiện Change, chỉ việc "vào" Dic "moi" ra xài thôi
 
Lần chỉnh sửa cuối:

tiendo1988

Thành viên chính thức
Tham gia ngày
6 Tháng tám 2009
Bài viết
82
Được thích
9
Điểm
670
Đây là thiếu sót của tất cả các code từ đầu topic đến giờ
Dùng sự kiện Worksheet_Change phải biết rằng Target không phải luôn là 1 cell ---> Đôi khi ngươi ta copy/paste( hoặc quét chọn khối cell rồi Delete như bạn làm) thì sao?
Chính vì thế phải cho thêm công đoạn quét toàn bộ các cell thuộc Target (For Each Clls in Target chẳng hạn)
Nói chung dạng bài này cũng đã từng post trên diễn đàn rồi... nếu khéo léo, có thể dùng Array để tăng tốc bảng tính
Các bạn khác đang nghiên cứu về VBA code thừ cải tiến lại xem
(tôi làm hoài dạng này đâm chán luôn)
--------------------------------------

Đây chính là lúc dùng đến Dictionary nè!
Tuy nhiên, nếu khéo hơn thì ta chỉ tạo và nạp Dictionary 1 lần duy nhất (nếu Dictionary chưa được tạo) ---> Những lần sau đó của sự kiện Change, chỉ việc "vào" Dic "moi" ra xài thôi
BÁc ndu96081631 Hướng dẫn cụ thể cách thêm For Each Clls in Target như thế nào?
“...có thể dùng Array để tăng tốc bảng tính” : bác gúp em và mọi người đoạn code để học hỏi thêm.
Nhờ bác cùng các Pro tùy biến giúp bài của em bên Topic Cần hướng dẫn và trợ giúp về sử dụng Vlookup trong VBA excel!

Xin cảm ơn!
 
Top Bottom