Xin viết dùng mã vba thay thế cho hàm vlookup (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

hoangvinh_tb

Thành viên mới
Tham gia
16/6/08
Bài viết
20
Được thích
4
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

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
 
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
 
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
 
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.
 
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.
 
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é.
 
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:
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

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
 
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
 
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
 
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.
 
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:
....
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
...
 
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!
 
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:
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'
 
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:
Đâ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!
 
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!
Làm thử trên file của bạn nhé:
Mô tả:
- Nhập liệu tại cột C
- Cột D, E, G, H, I và N là những cột cần lookup
- Vậy, nếu nhập liệu 1 hoặc nhiều cell trên cột C thì những cột D, E, G, H, I và N với dòng tương ứng sẽ lấy dữ liệu từ sheet LLNV gán vào
- Nếu 1 hoặc nhiều cell trên 1 C bị xóa thì thì những cột D, E, G, H, I và N với dòng tương ứng cũng sẽ bị xóa theo
Mô tả đúng chứ?
Nếu là vậy thì tôi để xuất code thế này:
1> Nạp Dictionary
PHP:
Public Chk As Boolean, Dic As Object, aResult()
Sub Auto_Open()
  Dim wks As Worksheet, SrcRng As Range, sArray
  Dim lR As Long, i As Long, n As Long, tmp
  On Error Resume Next
  Set wks = Sheets("LLNV")
  Set SrcRng = wks.Range("B6:R1000")
  sArray = SrcRng.Value
  ReDim aResult(1 To UBound(sArray, 1), 1 To UBound(sArray, 2))
  Set Dic = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(sArray, 1)
    If CStr(sArray(i, 1)) <> "" Then
      tmp = sArray(i, 1)
      If Not Dic.Exists(tmp) Then
        lR = lR + 1
        Dic.Add tmp, lR
        aResult(lR, 1) = tmp
        aResult(lR, 2) = sArray(i, 2)
        aResult(lR, 3) = sArray(i, 3)
        aResult(lR, 5) = sArray(i, 5)
        aResult(lR, 6) = sArray(i, 6)
        aResult(lR, 14) = sArray(i, 14)
        aResult(lR, 13) = sArray(i, 13)
      End If
    End If
  Next
End Sub
2> Theo dỏi những thay đổi tại Sheet LLNV (để cập nhật lại Dictionary)
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
  Chk = True
End Sub
PHP:
Private Sub Worksheet_Deactivate()
  If Chk Then
    Auto_Open
    Chk = False
  End If
End Sub
3> Nhập liệu và fill dữ liệu tại sheet ChiTiet
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rTarget As Range, aTarget, i As Long, n As Long
  Dim Arr1(), Arr2(), Arr3(), tmp
  On Error Resume Next
  If Dic Is Nothing Then Auto_Open
  If Not Intersect(Range("C6:C1000"), Target) Is Nothing Then
    Set rTarget = Intersect(Range("C6:C1000"), Target)
    If IsArray(rTarget.Value) Then
      aTarget = rTarget.Value
    Else
      ReDim aTarget(1 To 1, 1 To 1)
      aTarget(1, 1) = rTarget.Value
    End If
    ReDim Arr1(1 To UBound(aTarget, 1), 1 To 2)
    ReDim Arr2(1 To UBound(aTarget, 1), 1 To 3)
    ReDim Arr3(1 To UBound(aTarget, 1), 1 To 1)
    For i = 1 To UBound(aTarget, 1)
      If aTarget(i, 1) <> "" Then
        tmp = aTarget(i, 1)
        If Dic.Exists(tmp) Then
          Arr1(i, 1) = aResult(Dic.Item(tmp), 2)
          Arr1(i, 2) = aResult(Dic.Item(tmp), 3)
          Arr2(i, 1) = aResult(Dic.Item(tmp), 5)
          Arr2(i, 2) = aResult(Dic.Item(tmp), 6)
          Arr2(i, 3) = aResult(Dic.Item(tmp), 14)
          Arr3(i, 1) = aResult(Dic.Item(tmp), 13)
        End If
      End If
    Next
    rTarget.Offset(, 1).Resize(, 2).Value = Arr1
    rTarget.Offset(, 4).Resize(, 3).Value = Arr2
    rTarget.Offset(, 11).Resize(, 1).Value = Arr3
  End If
End Sub
Xem file đính kèm và thí nghiệm nhé ---> Có gì sơ sót, ta bàn tiếp
(Nói thiệt, làm mấy bài này chán bỏ xừ... lại hại não)
 

File đính kèm

Lần chỉnh sửa cuối:
Cám ơn bác ndu96081631, em d
em đang xem, nếu có gì em không hiểu hay cần giúp đỡ thêm mong bác và các AE giúp đỡ.
Chúc bác và mọi người sức khỏe!
 
Nguyên văn bởi siwtom 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

Bạn có để ý là tôi góp ý cho bài của bạn concogia chứ không phải trả lời bạn chủ topic?
Nếu tôi trả lời trực tiếp chủ topic thì dĩ nhiên code đề xuất là của tôi, nhưng tôi chỉ muốn góp ý với bạn concogia mà thôi.
Bạn concogia có viết: "Code trên là viết theo đề bài của bạn hoangvinh_tb". Tức chỉ viết cho vấn đề của chủ topic. Tôi thấy là để làm cái việc mà bạn concogia định làm thì không cần Dictionary. Tôi không khẳng định là để làm cái việc mà chủ topic định làm thì không cần dùng Dictionary. Nếu bạn concogia dùng Dictionary nhưng với code khác thì đã chắc gì tôi góp ý. Tôi không đề xuất cách giải quyết vấn đề của chủ topic, tôi góp ý cho người cụ thể, cho code cụ thể đáp ứng yêu cầu cụ thể bạn ạ. Rõ ràng là để làm cái việc mà code của concogia làm cho yêu cầu cụ thể thì chả cần gì tới Dictionary. Bạn trả lời người khác và dùng Dictionary nhưng tôi không có ý định góp ý vì tôi thấy nó hợp lý. Còn concogia dùng Dictionary trong code cụ thể ấy không hợp lý nên tôi góp ý. Không ai phê phán chuyện dùng Dictonary nhưng sau khi viết code thì nên xem lại xem liệu với cách làm việc như thế thì Dictionary có cần không. Vì rất có thể để làm y nguyên việc như thế không làm ÍT hơn và cũng không NHIỀU hơn thì có thể thay bằng code mới không dùng dictionary.
 
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.
Híc, hôm nay mình mới đọc được bài này. Ý của bạn siwtom cũng đúng thôi, thật ra bài này mình muốn thử Item của Dictionary là một Array xem nó như thế nào, xử lý nó có linh hoạt không thôi (trước kia mình hay gom vào một cục, khi xử lý thì dùng Split tách nó ra, sau khi đọc bài của bạn Kyo mình mới biết Item có thể là một Array _ vì toàn mò mẫm tự học_ ) chứ với đề bài trên & dữ liệu không thật lớn thì dùng Find ( bài của chị Hải Yến) hoặc chơi cùi bắp hơn thì dùng Match thì khỏi phải " Pho với Phiếc", "Đít-to với Đít-bé" chi cho rách việc
Thân ái
 
Híc, hôm nay mình mới đọc được bài này. Ý của bạn siwtom cũng đúng thôi, thật ra bài này mình muốn thử Item của Dictionary là một Array xem nó như thế nào, xử lý nó có linh hoạt không thôi (trước kia mình hay gom vào một cục, khi xử lý thì dùng Split tách nó ra, sau khi đọc bài của bạn Kyo mình mới biết Item có thể là một Array _ vì toàn mò mẫm tự học_ ) chứ với đề bài trên & dữ liệu không thật lớn thì dùng Find ( bài của chị Hải Yến) hoặc chơi cùi bắp hơn thì dùng Match thì khỏi phải " Pho với Phiếc", "Đít-to với Đít-bé" chi cho rách việc
Thân ái

Góp ý cũng chỉ là để lưu ý thôi.
Bạn nói rất đúng. Nhiều khi có thể viết một code tổng quát cho việc của mình rồi bất cứ trường hợp cụ thể nào cũng gọi cái code tổng quát kia nhưng như thế không tối ưu. Nếu nhu cầu của mình cụ thể thì có thể viết code cho trường hợp đó thì sẽ hay hơn. Tôi góp ý cho code cụ thể của bạn nhưng thực chất tôi muốn một điều khác. Có những người chập chững bước vào lập trình. Nếu ta biết thì ta giúp họ phân tích code để hiểu và có thể tối ưu nó. Hoặc nói về một trường hợp khác. Ai đó có một code và hỏi: sao em chạy code mà nó không làm theo ý muốn? Anh A trả lời: Bạn dùng code ở dưới của tôi nhé, chạy vù vù, tối ưu. Anh B nói: Bạn sai ở chỗ này, chỗ này. Anh A đưa ra được code tối ưu, giải quyết được vấn đề cần làm của người hỏi nhưng chỉ thế thôi. Anh B có thể biết viết code tối ưu hơn của người hỏi nhưng anh ta đặt cho mình mục đích khác với mục đích của anh A. Anh ta phân tích code của người hỏi và chỉ ra những chỗ sai. Như thế người hỏi sẽ biết mình sai chỗ nào để trong tương lai không mắc phải nữa. Mục đích của A và B là khác nhau. Rất có thể tôi sẽ là B vì mục đích tôi chọn khác với A
 
Rất cám ơn anh ndu96081631 đã giúp đỡ về code.
Do kiến thức của em về Code VBA quá hạn chế nên từ chiều đến giờ em ngồi xem code của bác và tìm cách để lookup những cột còn lại (K, L, M, O) mà em chưa làm được. mong anh chỉ cho.
ở trong Sheet ChiTiet, cột N (cột THƯỜNG TRÚ) hình như anh lookup nhầm cột "Nơi cấp" thì phải. anh sửa lại code giúp em nhé.

Nếu em có nhiều Sheet tương tự cần Lookup từ Sheet LLNV, mỗi Sheet có số cột cần lookup khác nhau và chỉ số cột cần lookup cũng khác nhau. Để có thể vận dụng code của anh vào những sheet này thì em cần lưu ý và thay đổi những chỗ nào trong code để đạt được yêu cầu lookup của các Sheet.

Rất mong anh ndu96081631 cùng các Pro trên GPE hướng dẫn thêm.
 
Rất cám ơn anh ndu96081631 đã giúp đỡ về code.
Do kiến thức của em về Code VBA quá hạn chế nên từ chiều đến giờ em ngồi xem code của bác và tìm cách để lookup những cột còn lại (K, L, M, O) mà em chưa làm được. mong anh chỉ cho.
ở trong Sheet ChiTiet, cột N (cột THƯỜNG TRÚ) hình như anh lookup nhầm cột "Nơi cấp" thì phải. anh sửa lại code giúp em nhé.

Nếu em có nhiều Sheet tương tự cần Lookup từ Sheet LLNV, mỗi Sheet có số cột cần lookup khác nhau và chỉ số cột cần lookup cũng khác nhau. Để có thể vận dụng code của anh vào những sheet này thì em cần lưu ý và thay đổi những chỗ nào trong code để đạt được yêu cầu lookup của các Sheet.

Rất mong anh ndu96081631 cùng các Pro trên GPE hướng dẫn thêm.

Kiến thức của tôi cũng vô cùng hạn chế nhưng tôi mạo muội có ý kiến. Tôi thấy đoạn
Mã:
If IsArray(rTarget.Value) Then
      aTarget = rTarget.Value
Else
      ReDim aTarget(1 To 1, 1 To 1)
      aTarget(1, 1) = rTarget.Value
End If
có vẻ chưa ổn lắm. Đểm kiểm nghiệm ta thử như sau:
Nếu vd. ND chọn xóa 1 ô ở cột C hoặc một loạt ô ở các dòng liên tiếp thì không sao. Nhưng nếu chọn vài ô không ở các dòng lên tiếp - tức từ "ô đầu" tới "ô cuối" có ô không được chọn để xóa thì code làm không theo ý muốn.
Nếu tôi nhầm lẫn thì xin thứ lỗi cho. Tôi chỉ muốn là nếu cảm nhận của tôi là đúng thì ai dùng cứ dùng nhưng phải ý thức được điều đó.
 
Kiến thức của tôi cũng vô cùng hạn chế nhưng tôi mạo muội có ý kiến. Tôi thấy đoạn
Mã:
If IsArray(rTarget.Value) Then
      aTarget = rTarget.Value
Else
      ReDim aTarget(1 To 1, 1 To 1)
      aTarget(1, 1) = rTarget.Value
End If
có vẻ chưa ổn lắm. Đểm kiểm nghiệm ta thử như sau:
Nếu vd. ND chọn xóa 1 ô ở cột C hoặc một loạt ô ở các dòng liên tiếp thì không sao. Nhưng nếu chọn vài ô không ở các dòng lên tiếp - tức từ "ô đầu" tới "ô cuối" có ô không được chọn để xóa thì code làm không theo ý muốn.
Nếu tôi nhầm lẫn thì xin thứ lỗi cho. Tôi chỉ muốn là nếu cảm nhận của tôi là đúng thì ai dùng cứ dùng nhưng phải ý thức được điều đó.
Ah... cái đoạn code đó không liên quan gì đến vấn đề bạn nói cả... Chẳng qua nếu chuyển toàn bộ sang Array thì phải lưu ý xem Target có phải là 1 cell hay không (nếu Target gồm nhiều cell thì Target.Value là 1 Array nhưng nếu Target là 1 cell thì Target.Value không phải là Array)
Còn vấn đề bạn vừa nói thật ra giải quyết nó cũng không có vấn đề gì... Có điều nếu chuyển mọi thứ sang xử lý mảng thì hơi rắc rối chút ----> Dạng Array trong Array đấy mà
Để từ từ tôi nghiên cứu thêm việc này
Cảm ơn bạn đã nhắc nhở!
 
Rất cám ơn anh ndu96081631 đã giúp đỡ về code.
Do kiến thức của em về Code VBA quá hạn chế nên từ chiều đến giờ em ngồi xem code của bác và tìm cách để lookup những cột còn lại (K, L, M, O) mà em chưa làm được. mong anh chỉ cho.
ở trong Sheet ChiTiet, cột N (cột THƯỜNG TRÚ) hình như anh lookup nhầm cột "Nơi cấp" thì phải. anh sửa lại code giúp em nhé.

Nếu em có nhiều Sheet tương tự cần Lookup từ Sheet LLNV, mỗi Sheet có số cột cần lookup khác nhau và chỉ số cột cần lookup cũng khác nhau. Để có thể vận dụng code của anh vào những sheet này thì em cần lưu ý và thay đổi những chỗ nào trong code để đạt được yêu cầu lookup của các Sheet.

Rất mong anh ndu96081631 cùng các Pro trên GPE hướng dẫn thêm.

Thật ra nếu bạn để ý các chỉ số trong code sẽ đoán được đang lookup ở cột nào
Ví dụ:
Arr3(i, 3) = aResult(Dic.Item(tmp), 11) ---> Lookup cột 11
Tại sao lại có Arr1, Arr2Arr3 ---> Vì Sheet ChiTiet các vùng cần lookup nằm không liền nhau: Cột D và E là 1 vùng, cột G, H, I là 1 vùng, cột N là 1 vùng (vị chi có 3 vùng, tương ứng với 3 Array sẽ gán vào)
Cái thằng Arr3 lúc trước chỉ gán cho 1 cột (cột N)... Giờ bạn thêm cột K, L, M, O ---> Các cột này cùng với cọt N tạo thành 1 vùng liên tục, vậy cho nó vào Arr3 luôn (5 cột)
Code sửa lại như sau:
PHP:
Public Chk As Boolean, Dic As Object, aResult()
Sub Auto_Open()
  Dim wks As Worksheet, SrcRng As Range, sArray
  Dim lR As Long, i As Long, j As Long, n As Long, tmp
  On Error Resume Next
  Set wks = Sheets("LLNV")
  Set SrcRng = wks.Range("B6:R1000")
  sArray = SrcRng.Value
  ReDim aResult(1 To UBound(sArray, 1), 1 To UBound(sArray, 2))
  Set Dic = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(sArray, 1)
    If CStr(sArray(i, 1)) <> "" Then
      tmp = sArray(i, 1)
      If Not Dic.Exists(tmp) Then
        lR = lR + 1
        Dic.Add tmp, lR
        For j = 1 To 17
          aResult(lR, j) = sArray(i, j)
        Next
      End If
    End If
  Next
End Sub
và:
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rTarget As Range, aTarget, i As Long, n As Long
  Dim Arr1(), Arr2(), Arr3(), tmp
  On Error Resume Next
  If Dic Is Nothing Then Auto_Open
  If Not Intersect(Range("C6:C1000"), Target) Is Nothing Then
    Set rTarget = Intersect(Range("C6:C1000"), Target)
    If IsArray(rTarget.Value) Then
      aTarget = rTarget.Value
    Else
      ReDim aTarget(1 To 1, 1 To 1)
      aTarget(1, 1) = rTarget.Value
    End If
    ReDim Arr1(1 To UBound(aTarget, 1), 1 To 2)
    ReDim Arr2(1 To UBound(aTarget, 1), 1 To 3)
    ReDim Arr3(1 To UBound(aTarget, 1), 1 To 5)
    For i = 1 To UBound(aTarget, 1)
      If aTarget(i, 1) <> "" Then
        tmp = aTarget(i, 1)
        If Dic.Exists(tmp) Then
          Arr1(i, 1) = aResult(Dic.Item(tmp), 2)
          Arr1(i, 2) = aResult(Dic.Item(tmp), 3)
          Arr2(i, 1) = aResult(Dic.Item(tmp), 5)
          Arr2(i, 2) = aResult(Dic.Item(tmp), 6)
          Arr2(i, 3) = aResult(Dic.Item(tmp), 14)
          Arr3(i, 1) = aResult(Dic.Item(tmp), 7)
          Arr3(i, 2) = aResult(Dic.Item(tmp), 8)
          Arr3(i, 3) = aResult(Dic.Item(tmp), 11)
          Arr3(i, 4) = aResult(Dic.Item(tmp), 15)
          Arr3(i, 5) = aResult(Dic.Item(tmp), 4)
        End If
      End If
    Next
    rTarget.Offset(, 1).Resize(, 2).Value = Arr1
    rTarget.Offset(, 4).Resize(, 3).Value = Arr2
    rTarget.Offset(, 8).Resize(, 5).Value = Arr3
  End If
End Sub
Các code khác giữ nguyên
Kiểm tra lại, trục trặc gì ta sẽ bàn tiếp
 

File đính kèm

Ah... cái đoạn code đó không liên quan gì đến vấn đề bạn nói cả... Chẳng qua nếu chuyển toàn bộ sang Array thì phải lưu ý xem Target có phải là 1 cell hay không (nếu Target gồm nhiều cell thì Target.Value là 1 Array nhưng nếu Target là 1 cell thì Target.Value không phải là Array)
Còn vấn đề bạn vừa nói thật ra giải quyết nó cũng không có vấn đề gì... Có điều nếu chuyển mọi thứ sang xử lý mảng thì hơi rắc rối chút ----> Dạng Array trong Array đấy mà
Để từ từ tôi nghiên cứu thêm việc này
Cảm ơn bạn đã nhắc nhở!

Tôi nghĩ là có liên quan. Với nghĩa là có thể phải thay nó bằng đoạn code khác, vì kiểm tra như thế dẫn tới việc đoạn code tiếp theo làm việc không đúng.
Không biết bạn có đọc kỹ bài của tôi không.
Thứ nhất tôi đọc code (của bạn hay code nào khác) thì tôi hiểu ý đồ của người lập trình và tại sao lại muốn làm thế. Thứ hai: tôi thấy các code còn lại nhìn có vẻ đúng nên tôi nghi ngờ
Mã:
If IsArray(rTarget.Value) Then
      aTarget = rTarget.Value
Else
      ReDim aTarget(1 To 1, 1 To 1)
      aTarget(1, 1) = rTarget.Value
End If
Mà nghi cũng phải thôi, tiếp theo tôi sẽ viết về nó. Chỗ này tôi muốn lưu ý. Bạn viết: "nếu Target gồm nhiều cell thì Target.Value là 1 Array". Chỗ này không chính xác (tôi không nói là không đúng, chỉ nói là không chính xác, hay nói khác đi thì "cũng còn tùy"). Ở dưới tôi sẽ viết.
Thứ ba tôi viết: "Nhưng nếu chọn vài ô không ở các dòng lên tiếp - tức từ "ô đầu" tới "ô cuối" có ô không được chọn để xóa thì code làm không theo ý muốn".
Bạn hãy chọn trong cột C 2 ô liên tiếp, bỏ 1 ô sau đó chọn 99 ô nữa (liên tiếp hay không không cần), tổng cộng 101 ô. Lúc này IsArray(rTarget.Value) = TRUE, và UBound(aTarget, 1) (dùng trong FOR) bằng ........... 2. Tôi hiểu là chỉ 2 ô đầu liên tiếp được tính, 99 ô sau coi như là mất. Nhưng thậm chí 2 dòng có 2 ô đầu này không được xóa, chứng tỏ code
Mã:
rTarget.Offset(, 1).Resize(, 2).Value = Arr1
rTarget.Offset(, 4).Resize(, 3).Value = Arr2
rTarget.Offset(, 8).Resize(, 5).Value = Arr3
không thực hiện.
Trong trường hợp này
Mã:
If aTarget(i, 1) <> "" Then
End If
không được thực hiện vì các ô đã xóa là rỗng, chứng tỏ Arr1, Arr2, Arr3 chứa các giá trị rỗng. Nhưng 2 dòng đầu không được xóa điều này chứng tỏ cụm "rTarget.Offset ... " không thực hiện đúng.
Bây giờ ta chỉ chọn 1 ô, sau đó bỏ 1 ô, tiếp theo chọn 100 ô rồi xóa. Có 101 ô chọn nhưng IsArray(rTarget.Value) = FALSE. Tôi hiểu do chỉ tính ô đầu. Cái tôi viết "cũng còn tùy" chính là đây - so sánh 2 trường hợp chọn 101 ô
 
Cám ơn Bác ndu96081631. Cả buổi sáng nay em ngồi ở nhà nghiên cứu đoạn code hôm qua anh viết cho. Em đã hiểu được chút ít và biết cách sửa thông tin để lookup được cho các cột khác. Giờ em mới online thấy bác sửa lại một chút trong code và có những cập nhật thiệt hay: ở phần Nạp Dictionary theo hướng linh hoạt hơn không cần phải sửa trong đó nữa khi thay đổi cột cần lookup bên Sheet ChiTiet.

Cho em hỏi mở rộng ra ngoài bài hiện tại của em một chút: trường hợp như sau:
  1. Nếu ở Sheet LLNV phần SỐ THẺ (hay còn gọi là mã số Nhân Viên) nằm ở cột F chẳng hạn, và ở các cột A, B, C, D, E vẫn có dữ liệu liên quan.
- Đặt ra trường hợp: trên Sheet ChiTiet nếu cần lookup những giá trị trên một trong các cột A, B, C, D, E của LLNV theo SỐ THẺ thì có thể Lookup được không bác? Nếu được thì code sẽ thay đổi như thế nào?
  1. Nếu cột cần lookup ở Sheet Chitiet nằm ở bên trái của cột SỐ THẺ thì cần thay đổi code thế nào cho phù hợp ạ?
Trong file đính kèm em có thay đổi thứ tự một số cột để phù hợp với nội dung em hỏi thêm. Sheet LLNV vẫn là DATA gốc.

Cám ơn Bác ndu96081631 cùng các AE GPE đã quan tâm, giúp đỡ và chia sẻ.

Mong bác cùng mọi người dành thêm chút thời gian cho phần em hỏi thêm.
 

File đính kèm

Lần chỉnh sửa cuối:
Bài này cần xem lại ý tưởng ngay từ đầu: không thể viết hàm VBA mà nhanh hơn Vlookup được, Chắc chắn là chậm hơn hàm gốc, có chăng là cái "chậm nhiều" này được chia đều ra và đẩy vào ngay giai đoạn nhập liệu.

Nếu xem xét ý tưởng dưới góc độ thế, thì khỏi cần phải VBA code dài dòng vậy, mà hãy dùng ngay Vlookup chuẩn sẵn có trong Excel và biến thành "giá trị" (value) là đủ

Thấy file của người hỏi đều là "thuc hanh" -- chứng tỏ người hỏi đang muốn học hỏi lập trình, vậy hãy chúng ta phải nhìn nhận lại ý tưởng ngay từ đâu

Nếu ý kiến tôi có không hợp, thì có thể do tiêu đề topic là chưa chuẩn sát
 
Lần chỉnh sửa cuối:
Bài này cần xem lại ý tưởng ngay từ đầu: không thể viết hàm VBA mà nhanh hơn Vlookup được, Chắc chắn là chậm hơn hàm gốc, có chăng là cái "chậm nhiều" này được chia đều ra và đẩy vào ngay giai đoạn nhập liệu.
Dám cá với bạn là nhanh gấp 100 lần (nếu không thì người ta xài công thức cho rồi)
Còn dùng VBA mà "mượn tạm" thằng VLOOKUP để làm cũng chậm luôn (được cái code gọn thôi)... Chỉ có cách dùng Array mới là nhanh nhất thôi
Không tin bạn có thể thí nghiệm với dữ liệu tùy ý
---------------------
Với siwtom: Bạn chỉ mô tả sơ qua là tôi đã hiểu rồi ---> Nói chung là tôi biết phải sửa chổ nào, thêm bớt chổ nào... nhưng vấn đề này tôi sẽ viết tiếp trong dịp khác
(dù sao thì cũng không khoái mấy vụ này lắm vì nó không.. MỚI... Ẹc... Ẹc...)
 
Lần chỉnh sửa cuối:
Dám cá với bạn là nhanh gấp 100 lần (nếu không thì người ta xài công thức cho rồi)
Còn dùng VBA mà "mượn tạm" thằng VLOOKUP để làm cũng chậm luôn... Chỉ có cách dùng Array mới là nhanh nhất thôi
Không tin bạn có thể thí nghiệm với dữ liệu tùy ý

Vấn đề là anh nhận định sai rồi, Hàm của anh không nhanh hơn Vlookup được, cái này là chắc chắn

Còn "mượn tạm" thì tôi không nhận xét, vì thí nghiệm kiểu dữ liệu này không chuẩn, và hơn nữa trình VBA của tôi cũng có hạn.
 
Bài này cần xem lại ý tưởng ngay từ đầu: không thể viết hàm VBA mà nhanh hơn Vlookup được, Chắc chắn là chậm hơn hàm gốc, có chăng là cái "chậm nhiều" này được chia đều ra và đẩy vào ngay giai đoạn nhập liệu.

Nếu xem xét ý tưởng dưới góc độ thế, thì khỏi cần phải VBA code dài dòng vậy, mà hãy dùng ngay Vlookup chuẩn sẵn có trong Excel và biến thành "giá trị" (value) là đủ

Thấy file của người hỏi đều là "thuc hanh" -- chứng tỏ người hỏi đang muốn học hỏi lập trình, vậy hãy chúng ta phải nhìn nhận lại ý tưởng ngay từ đâu

Nếu ý kiến tôi có không hợp, thì có thể do tiêu đề topic là chưa chuẩn sát

- Mình thiết nghĩ nếu ý tưởng viết code VBA để thay cho công thức và hàm (ở đây là thay cho hàm Vlookup) sử dụng phải nhập ở trên các Cells để đáp ứng cho việc Dữ liệu bảng tính nhiều hàng nhiều cột sử dụng hàm Vlookup nhiều là rất tiện và cần thiết.
- Mình thì chưa hiều gì về lập trình nên việc sử dụng code vào file chạy nhanh hay chậm thì mình không rõ. song đọc một số bài trên GPE thì việc file chạy nhanh hay chậm hơn khi sử dụng hàm Vlookup cũng như các hàm khác trên các cells, các cột trong bảng tính còn phụ thuộc vào phương pháp của người viết đoạn code đó nữa.
- Không dấu gì bạn và mọi người, mình làm ở bộ phận nhân sự, chỗ mình làm vẫn quản lý nhân viên trên Excel và toàn bộ là nhập liệu bằng tay hết, rất mất thời gian. để tiện cho việc quản lý nhân viên mình đang mò mẫm hoàn chỉnh lại các mẫu biểu quản lý và các hàm, công thức sử dụng trong đó để thuận tiện hơn cho công việc quản lý nhân viên của mình. Vì vậy mình để tên file là Thực hành. Và mình cũng muốn tìm hiểu thêm một chút VBA để vận dụng cho công việc hiện tại của mình.
 
Lần chỉnh sửa cuối:
- Không dấu gì bạn và mọi người, mình làm ở bộ phận nhân sự, chỗ mình làm vẫn quản lý nhân viên trên Excel và toàn bộ là nhập liệu bằng tay hết, rất mất thời gian. để tiện cho việc quản lý nhân viên mình đang mò mẫm hoàn chỉnh lại các mẫu biểu quản lý và các hàm, công thức sử dụng trong đó để thuận tiện hơn cho công việc quản lý nhân viên của mình. Vì vậy mình để tên file là Thực hành. Và mình cũng muốn tìm hiểu thêm một chút VBA để vận dụng cho công việc hiện tại của mình.

Vậy bạn cứ tiếp tục ứng dụng trường hợp cụ thể này, Có chăng ở đây tôi ý kiến về tên topic nó không chuẩn sát với nội dung yêu cầu thực sự, Điều này quan trọng cho việc người sau đọc và ứng dụng, nếu vẫn thế họ sẽ hiểu là không nên sử dụng Vlookup

còn trường hợp riêng như của bạn thì là đặc thù rồi -- ở đây tôi đang nói về việc quan điểm lập trình, và phương pháp đó.
 
Vấn đề là anh nhận định sai rồi, Hàm của anh không nhanh hơn Vlookup được, cái này là chắc chắn
.
Thật ra tôi rất thích tranh luận để chứng minh vấn đề
Vậy thay vì nói suông ta làm cuộc thí nghiệm với 10000 dòng dữ liệu giữa code của tôi VS với VLOOKUP nhé (xem file)
Tại sheet ChiTiet, điền dữ liệu vào cột C rồi lookup 16 cột còn lại bên phải
Code của tôi như sau:
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rTarget As Range, aTarget, i As Long, j As Long, n As Long, TG As Double
  Dim Arr(), tmp
  On Error Resume Next
  TG = Timer
  If Dic Is Nothing Then Auto_Open
  If Not Intersect(Range("C6:C65536"), Target) Is Nothing Then
    Set rTarget = Intersect(Range("C6:C65536"), Target)
    If IsArray(rTarget.Value) Then
      aTarget = rTarget.Value
    Else
      ReDim aTarget(1 To 1, 1 To 1)
      aTarget(1, 1) = rTarget.Value
    End If
    ReDim Arr(1 To UBound(aTarget, 1), 1 To 17)
    For i = 1 To UBound(aTarget, 1)
      If aTarget(i, 1) <> "" Then
        tmp = aTarget(i, 1)
        If Dic.Exists(tmp) Then
          For j = 2 To 17
            Arr(i, j - 1) = aResult(Dic.Item(tmp), j)
          Next
        End If
      End If
    Next
    rTarget.Offset(, 1).Resize(, 16).Value = Arr
    MsgBox Timer - TG
  End If
End Sub
- Còn code "mượn" VLOOKUP như sau:
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rTarget As Range, aTarget, i As Long, j As Long, n As Long, TG As Double
  Dim Arr(), tmp
  On Error Resume Next
  TG = Timer
  If Not Intersect(Range("C6:C65536"), Target) Is Nothing Then
    Set rTarget = Intersect(Range("C6:C65536"), Target)
    With rTarget.Offset(, 1).Resize(, 16)
      .Value = "=IF(RC3="""","""",VLOOKUP(RC3,LLNV!R5C2:R10000C18,2,0))"
      .Value = .Value
    End With
    MsgBox Timer - TG
  End If
End Sub
Code này tương đương bạn tự tay gõ hàm VLOOKUP vào rồi copy/paste value thôi (tôi nghĩ không khó hiểu đối với bạn)
----------------
Giờ so sánh khi copy paste 10000 dòng dữ liệu vào cột C của sheet ChiTiet (dữ liệu tôi đã làm sẵn tại sheet1)
- Code tôi viết trên nền tảng xử lý mảng cho kết quả trong vòng 1.1 giây
- Code dùng VLOOKUP cho kết quả không vòng 25 giây
Đó là chưa nói code dùng VLOOKUP chỉ tìm duy nhất trên cột 2 ---> Nếu tìm 1 lần 16 cột như code của tôi dùng Array chắc là cách dùng VLOOKUP sẽ... đói luôn
Nếu thay đoạn "VLOOKUP(RC3,LLNV!R5C2:R10000C18, 2,0)" thành "VLOOKUP(RC3,LLNV!R5C2:R10000C18, COLUMNS(RC3:RC),0)" để lookup luôn 16 cột thì... Ẹc.. Ẹc... tôi không kiên nhẩn để chờ (lâu quá, treo máy luôn)
Đương nhiên khi làm cuộc thí nghiệm này tôi đã thử bằng rất nhiều cách với VLOOKUP... Chẳng hạn dùng WorksheetFunction.Vlookup ---> Kết quả còn tệ hơn rất nhiều
Còn "mượn tạm" thì tôi không nhận xét, vì thí nghiệm kiểu dữ liệu này không chuẩn, và hơn nữa trình VBA của tôi cũng có hạn.
Bạn muốn dữ liệu "chuẩn" thế nào, hoặc muốn sửa VLOOKUP như thế nào, cứ đưa lên đây, chúng ta sẽ cùng thí nghiệm để bạn tâm phục khẩu phục về tốc độ của xử lý Array
 

File đính kèm

Lần chỉnh sửa cuối:
Dĩ nhiên là Code của thày Ndu nhanh hơn rất nhiều, nếu dùng VBA mà mượn Vlookup của Excel thì chẳng thà sài Vlookup của Excel cho xong cần VBA làm gì.

vodoi2x: Từ hôm nọ tôi đọc rất nhiều bài của bác, phải nói bác rất chịu khó tranh luận, tuy vậy một số bài tranh luận của bác (không phải tất cả) dường như có cảm giác thiếu cơ sở gì đó (có lẽ nhiều vấn đề bác hiểu không sâu như các thày trên diễn đàn).
 
Lần chỉnh sửa cuối:
Thật ra tôi rất thích tranh luận để chứng minh vấn đề
Vậy thay vì nói suông ta làm cuộc thí nghiệm với 10000 dòng dữ liệu giữa code của tôi VS với VLOOKUP nhé (xem file)

Bạn muốn dữ liệu "chuẩn" thế nào, hoặc muốn sửa VLOOKUP như thế nào, cứ đưa lên đây, chúng ta sẽ cùng thí nghiệm để bạn tâm phục khẩu phục về tốc độ của xử lý Array

Anh tính thời gian thế này thì sai rồi, anh phải tính cả thời gian mà load cho diction ary ban đầu nữa, Còn anh làm thế này thì phải so sánh với dấu = của excel thôi, vì lúc đó dic sẵn sàng cả rồi
Song nhờ đó tôi mới hiểu anh đang hiểu sai, mỗi người nghĩ theo 1 hướng.

Tôi đã viết là với hàm lập VBA so sánh cùng hàm chuẩn Vlookup trong excel thì sẽ chậm hơn là cái chắc chắn, NÊN tôi mới nói chủ topic xem lại tiêu đề cho hợp lý,

Còn so sánh kiểu anh thì là so sánh thật khập khiễng còn nếu muốn đọ thì anh phải viết 1 hàm cùng lúc enter vào với hàm có sẵn VLOOKUP thì sẽ biết tay ngay.
 
vodoi2x: Từ hôm nọ tôi đọc rất nhiều bài của bác, phải nói bác rất chịu khó tranh luận, tuy vậy một số bài tranh luận của bác (không phải tất cả) dường như có cảm giác thiếu cơ sở gì đó (có lẽ nhiều vấn đề bác hiểu không sâu như các thày trên diễn đàn).

cám ơn,
bạn nên đọc kỹ điều tôi viết nhé, tôi cũng mới sơ sơ VBA chắc cũng không sâu như bạn đâu, nhưng cái gì đúng thì là nó phải đúng, chúng ta không the a dua theo 1 chiều, mà không theo cái chuẩn ah,
 
Anh tính thời gian thế này thì sai rồi, anh phải tính cả thời gian mà load cho diction ary ban đầu nữa,.
Thì bạn cứ thử đi
Đoạn:
If Dic Is Nothing Then Auto_Open
Hãy sửa thành
Auto_Open
rồi thí nghiệm lại sẽ biết liền chứ gì
Chấp luôn việc lúc nào cũng load Dictionary đấy, cùng lắm thêm 0.5 giây
Trước khi kết luận, tôi đã thí nghiệm không biết bao nhiêu lần rồi mới dám nói
Thật ra tôi nói nhanh gấp 100 lần so với VLOOKUP là đã hơi.. khiêm tốn rồi đấy
Nếu bạn có ý kiến phản bác gì khác, chúng ta cùng tiếp tục
Ẹc... Ẹc...
----------------------
Tôi đã viết là với hàm lập VBA so sánh cùng hàm chuẩn Vlookup trong excel thì sẽ chậm hơn là cái chắc chắn, NÊN tôi mới nói chủ topic xem lại tiêu đề cho hợp lý,
.
Bạn cứ hay lòng vòng không đi thằng vào vấn đề
Từ đầu topic này, có ai bảo sẽ VIẾT 1 HÀM ĐỂ THAY THẾ CHO VLOOKUP CỦA BÁC BILL đâu chứ... Cả tiêu đề cũng ghi rằng "Mã VBA để thay hàm VLOOKUP" ... Hiện tai người ta đang cần biện pháp dùng VBA để thay thế cho việc nhập VLOOKUP vào Excel
Thế thôi! Còn bạn lại thích chơi chữ
Vấn đề là người dùng áp dụng được và họ hài lòng là đủ
 
Lần chỉnh sửa cuối:
Thì bạn cứ thử đi
Đoạn:
If Dic Is Nothing Then Auto_Open
Hãy sửa thành
Auto_Open
rồi thí nghiệm lại sẽ biết liền chứ gì
Ẹc... Ẹc...

Oh, anh vẫn ngoan cố hiểu sai hướng (hay cố tình nhỉ), hihihiiiii
Ý của tôi ở đây là không phải bài cụ thể này (vì đó không phải là chuẩn).

Anh cứ viết 1 hàm bằng VBA đầy đủ chức năng như của VLookup rồi đem so sánh nhé, chứ nói đi nói lại, anh cũng mãi không hiểu, ĐIều gì đúng chúng ta phải công nhận là đúng thì phải đúng: VBA chỉ là công cụ trợ giúp thôi - cái nào có sẵn thì nên sử dụng vẫn hơn.


Đó là lý do tôi ý kiến về tiêu đề topic, song vẫn khuyên chủ topic theo hướng giải quyết đó -- (anh đọc lại bài tôi viết trả lời chủ topic là hiểu ngay)
Thanks
 
Oh, anh vẫn ngoan cố hiểu sai hướng (hay cố tình nhỉ), hihihiiiii
Ý của tôi ở đây là không phải bài cụ thể này (vì đó không phải là chuẩn).

Anh cứ viết 1 hàm bằng VBA đầy đủ chức năng như của VLookup rồi đem so sánh nhé, chứ nói đi nói lại, anh cũng mãi không hiểu, ĐIều gì đúng chúng ta phải công nhận là đúng thì phải đúng: VBA chỉ là công cụ trợ giúp thôi - cái nào có sẵn thì nên sử dụng vẫn hơn.


Đó là lý do tôi ý kiến về tiêu đề topic, song vẫn khuyên chủ topic theo hướng giải quyết đó -- (anh đọc lại bài tôi viết trả lời chủ topic là hiểu ngay)
Thanks
Có vẻ như tranh luận chẳng đi đến đâu (ông nói gà bà nói vịt)
Và ý kiến của bạn thật ra cũng chẳng liên quan gì đến chủ đề của topic
Mục đích của người ta là làm cách nào đó để khỏi phải gõ VLOOKUP trên bảng tính, vậy thôi! Chẳng ai có ý đồ xây dựng bất kỳ hàm nào thay thế hàm Excel cả (mà nếu có ý đó cũng e rằng không ai có khả năng)
Vậy đi nha! Nếu ai đó có ý kiến tôi ưu hóa những code trong topic này thì mời tiếp tục, còn không thì bàn ở chổ khác vậy!
 
Có vẻ như tranh luận chẳng đi đến đâu (ông nói gà bà nói vịt)
Và ý kiến của bạn thật ra cũng chẳng liên quan gì đến chủ đề của topic

Thế mới nói là anh hiểu sai, cứ lo nhanh chậm hơn làm gì

Có liên quan chủ topic, những người mới vào tưởng có gì ghê ghớm thay VLookup - dễ gây hiểu nhầm chứ,

tóm lại, chúc anh tiếp tục có bài nhiều để code hơn nữa, ...
 
Cho em hỏi mở rộng ra ngoài bài hiện tại của em một chút: trường hợp như sau:
  1. Nếu ở Sheet LLNV phần SỐ THẺ (hay còn gọi là mã số Nhân Viên) nằm ở cột F chẳng hạn, và ở các cột A, B, C, D, E vẫn có dữ liệu liên quan.
- Đặt ra trường hợp: trên Sheet ChiTiet nếu cần lookup những giá trị trên một trong các cột A, B, C, D, E của LLNV theo SỐ THẺ thì có thể Lookup được không bác? Nếu được thì code sẽ thay đổi như thế nào?
  1. Nếu cột cần lookup ở Sheet Chitiet nằm ở bên trái của cột SỐ THẺ thì cần thay đổi code thế nào cho phù hợp ạ?
Trong file đính kèm em có thay đổi thứ tự một số cột để phù hợp với nội dung em hỏi thêm. Sheet LLNV vẫn là DATA gốc.

Cám ơn Bác ndu96081631 cùng các AE GPE đã quan tâm, giúp đỡ và chia sẻ.

Mong bác cùng mọi người dành thêm chút thời gian cho phần em hỏi thêm.
Rảnh rỗi làm lại cho bạn theo sự bố trí của dữ liệu mới đây
Xem và kiểm tra lại nhé
 

File đính kèm

cám ơn bác ndu96081631, thiệt là hay.
Có lẽ khi nào em xây dựng xong mô hình quản lý công việc( các bảng biểu trong công việc của em phải làm) sẽ nhờ bác cùng các AE viết code xử lý dữ liệu giúp em để cho file chạy nhẹ và nhanh hơn, công việc được giải quyết nhanh hơn.
Hy vọng khi đó sẽ nhận được sự giúp đỡ của mọi người.

Em xin gửi lời cảm ơn tới bác ndu96081631 nói riêng và các AE GPE nói chung.
Chúc mọi người sức khỏe và diễn đàn ngày một lớn mạnh.
 
Đâ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
Em cảm ơn bác ndu96081631 Quả thực em chẳng biết gì về VBA, em đã nghiên cứu bài viết của bác, đã ứng dụng vào bài của em nhưng không được. Rất mong bác bỏ chút thời gian giúp em bài toán này. Em gửi file đính kèm, bác giúp em nhé. Em cảm ơn bác nhiều.
 

File đính kèm

Em cảm ơn bác ndu96081631 Quả thực em chẳng biết gì về VBA, em đã nghiên cứu bài viết của bác, đã ứng dụng vào bài của em nhưng không được. Rất mong bác bỏ chút thời gian giúp em bài toán này. Em gửi file đính kèm, bác giúp em nhé. Em cảm ơn bác nhiều.
Sửa code bài 45 lại tí thôi mà (sửa tham chiếu cho phù hợp dữ liệu của bạn)
Xem file
 

File đính kèm

Sửa code bài 45 lại tí thôi mà (sửa tham chiếu cho phù hợp dữ liệu của bạn)
Xem file
Em cảm ơn bác, vậy mà em mò mẫm mãi không được. Có một vấn đề nữa nhờ bác chỉ giúp. Giả sử file trên có nhiều sheet CT, CT1, CT2,....CTn. Sửa code trong sheet 'MA' như thế nào để khi thay đổi giá trị trong sheet 'MA' thì các giá trị tương ứng trong Sheet CT, CT1, CT2,...,CTn cũng thay đôi theo. Thank bác nhiều.
 
Em cảm ơn bác, vậy mà em mò mẫm mãi không được. Có một vấn đề nữa nhờ bác chỉ giúp. Giả sử file trên có nhiều sheet CT, CT1, CT2,....CTn. Sửa code trong sheet 'MA' như thế nào để khi thay đổi giá trị trong sheet 'MA' thì các giá trị tương ứng trong Sheet CT, CT1, CT2,...,CTn cũng thay đôi theo. Thank bác nhiều.
Để khỏi mất công làm hoài, bạn đưa file chuẩn nhất (mà bạn đang dùng) lên đây nhé
 
Ái chà... File của bạn rối như tơ vò... nhìn vào tôi chẳng biết phải dùng sự kiện Change như thế nào, tại các cell nào nữa đây
Hì, cảm ơn bác. Vậy bác xử lý cái cũ giúp em vậy nhé.
làm thế nào khi thay đổi giá trị ở shet 'MA' Thì giá trị ở các sheet khác cũng thay đổi?
 

File đính kèm

em rất cảm ơn sự chân thành của các bạn trên GPE
 
Lần chỉnh sửa cuối:
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
Chào các bạn
Vẫn File ở bài 1 và code trên
Bây giờ mình kg muốn sử dụng sự kiện Sub Worksheet_Change mà muốn sửa code để ở module, để khi muốn chạy code thì chọn nó để run, mong các bạn chỉ giúp
Cảm ơn cả nhà
 
[Thongbao]Vẫn File ở bài 1 và code trên
Bây giờ mình kg muốn sử dụng sự kiện Sub Worksheet_Change mà muốn sửa code để ở module, để khi muốn chạy code thì chọn nó để run, mong các bạn chỉ giúp; Cảm ơn cả nhà[/Thongbao]

Bạn kích hoạt ô chứa mã NV & chạy cái ni:

PHP:
Option Explicit
Sub GPE()
    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(Selection.Value, , xlFormulas, xlWhole)  '<=|'
    If sRng Is Nothing Then
        Target.Offset(, 1).Value = "Nothing"
    Else
        Target.Offset(, 1).Resize(, 2).Value = sRng.Offset(, 1).Resize(, 2).Value
    End If
End Sub
 
[Thongbao]Vẫn File ở bài 1 và code trên
Bây giờ mình kg muốn sử dụng sự kiện Sub Worksheet_Change mà muốn sửa code để ở module, để khi muốn chạy code thì chọn nó để run, mong các bạn chỉ giúp; Cảm ơn cả nhà[/Thongbao]

Bạn kích hoạt ô chứa mã NV & chạy cái ni:

PHP:
Option Explicit
Sub GPE()
    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(Selection.Value, , xlFormulas, xlWhole)  '<=|'
    If sRng Is Nothing Then
        Target.Offset(, 1).Value = "Nothing"
    Else
        Target.Offset(, 1).Resize(, 2).Value = sRng.Offset(, 1).Resize(, 2).Value
    End If
End Sub
Em đã chép code trên vào module, nhập thử số liệu vào cột Mã của trang "Chitiet", nhấn Alt+F8 để run GEP thì bị báo lỗi chỗ Target
Anh xem lại giúp!Tks
 
Chào các bạn
Vẫn File ở bài 1 và code trên
Bây giờ mình kg muốn sử dụng sự kiện Sub Worksheet_Change mà muốn sửa code để ở module, để khi muốn chạy code thì chọn nó để run, mong các bạn chỉ giúp
Cảm ơn cả nhà

Thì bạn xóa code sự kiện Change ở Sheet CT đi, xong viết thêm 1 code ngắn thế này:
Mã:
Sub Main()
  Update Sheets("CT").Range("B4:B1000")
End Sub
Lưu ý:
- Nếu bạn đang Test code trực tiếp thì phải Alt + F8, chạy Sub Auto_Open trước, xong mới chạy Sub Main nhé
- Chỉ cần chạy Auto_Open 1 lần là đủ
- Nếu đã Save và Close file rồi, lần sau mở file lên, không cần phải chạy Auto_Open
 
xin được xía vdzô chút nha,
bạn thử thay target bằng activecell xem
vì thông thường tôi thấy người ta hay sử dụng target ở trong mấy cái event vì nó đã được khai báo rồi, còn trong module thì chưa khai báo,
 
chào cả nhà, e mới bắt đầu tập toẹ dùng vba nên muốn hỏi một chút ạ, giống như ở bài 1 của bác hoangvinh_tb nhưng giả sử như trong file đó ở sheet "MA" có cột ma&ten giống nhau còn địa chỉ thì khác nhau(tức là có nhiều địa chỉ với cùng một mã và tên) giờ ở sheet"CT" em muốn gõ mã thì nó sẽ hiển thị ra được tên và địa chỉ(toàn bộ địa chỉ của mã đó) thì phải làm thế nào ạ? e cảm ơn các bác nhiều. do mới chập chững bước vào nên có gì mong được các bác chỉ giáo hộ, đừng ném gạch e ạ.
 
Bạn giúp viết code VBA cho hàm Tìm Kiếm giúp mình cho file đính kèm sau
Cám ơn
cách gửi file đính kèm thế nào?
 
Bạn giúp viết code VBA cho hàm Tìm Kiếm giúp mình cho file đính kèm sau
Cám ơn
cách gửi file đính kèm thế nào?
Bạn nhấn vào nút Đổi sang khung lớn, sẽ nhìn thấy nút lệnh đính kèm file trên thanh công cụ soạn thảo.
 
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ình đã sửa ngay trong file bạn gửi rồi đó. (Mình mới tập học VBA thôi, mò mẫm tự nhiên được). cái đoạn mã này hay quá. nhân tiện mình cám ơn bác concogia nha. Không biết gửi file lên.
 
thêm ký tự trước mã

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
Cho e hỏi thêm các thầy/anh/chị chút
Sheet mã của e nó lại thêm ký tự "_" ở trước mã thì code thay đổi thế nào ạh, sheet CT thì nhập ko có ký tự "_" ạh.. e cảm ơn
 

File đính kèm

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
    Const GD As String = "_"            '<=|'
    
    Set Sh = ThisWorkbook.Worksheets("MA")
    Set Rng = Sh.Range(Sh.[b2], Sh.[b2].End(xlDown))
    Set sRng = Rng.Find(GD & 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

Thử xem sao nha bạ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
    Const GD As String = "_"            '<=|'
    
    Set Sh = ThisWorkbook.Worksheets("MA")
    Set Rng = Sh.Range(Sh.[b2], Sh.[b2].End(xlDown))
    Set sRng = Rng.Find(GD & 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

Thử xem sao nha bạn!
Hình như cái ký tự do hệ thống tạo ra nó ko phải nút Shift - bình thường thì phải, e cố thẻ thay thế mà ko có được
 

File đính kèm

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
    Const GD As String = "_"            '<=|'
    
    Set Sh = ThisWorkbook.Worksheets("MA")
    Set Rng = Sh.Range(Sh.[b2], Sh.[b2].End(xlDown))
    Set sRng = Rng.Find(GD & 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

Thử xem sao nha bạn!
E chưa hiểu lắm về 2 dòng code này, mong anh giải thích
Set Rng = Sh.Range(Sh.[b2], Sh.[b2].End(xlDown))
Target.Offset(, 1).Resize(, 2).Value = sRng.Offset(, 1).Resize(, 2).Value
E cảm ơn nhiều
 
E chưa hiểu lắm về 2 dòng code này, mong anh giải thích

(1) Set Rng
= Sh.Range(Sh.[b2], Sh.[b2].End(xlDown))

(2)Target
.Offset(, 1).Resize(, 2).Value = sRng.Offset(, 1).Resize(, 2).Value


Đây là macro sự kiện, nên khi ta truy xuất vùng dữ liệu (vùng) ở trang tính khác, ta cần tên trang tính mà vùng đang hiện hữu, cụ thể ở đây là trang 'Ma' (Thực chất trang này ta đã đem gán vô biến đối tượng Sh )

Một khi ta muốn gán 1 vùng ở trang khác (với trang ta đang đứng) ta fải réo gọi cả tên cha/mẹ đẽ ra vùng đó (cụ thể là Sh)
Còn tại sao [B2] mà không là [B3] thì lại liên quan đến fương thức FIND() của dòng lệnh bên dưới;

Nôm na là đem vùng giới hạn bỡi 2 ô của trang Sh đem gán vô biến Rng đã khai báo;
(1) Ô đầu là ô Sh.[B2]
(2) Ô cuối là ô Sh.[B2].End(XlDown)

Ở (2) có thể bạn sẽ thấy có người viết Sh.[B65535].End(xlUp)
Cả 2 cách viết đều cùng kết quả là lấy ô cuối có dữ liệu của cột
Nhưng cách viết trong câu lệnh bạn hỏi iêu cầu CSDL fải tuân thủ là 1 CSDL (Là không có ô nào trong cột này được trống, mà bên dưới nó có dữ liệu)

(Về fương thức End(xl. . . ) & câu lệnh thứ hai mà bạn hỏi, bạn tìm đọc trên diễn đàn;
Mình gợi í 1 chổ đọc nó: "Chập chững đến với VBA" )
 
Nothing

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
    Const GD As String = "_"            '<=|'
    
    Set Sh = ThisWorkbook.Worksheets("MA")
    Set Rng = Sh.Range(Sh.[b2], Sh.[b2].End(xlDown))
    Set sRng = Rng.Find(GD & 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

Thử xem sao nha bạn!
Không hiểu sao nó lại ra NOTHING ạh
 

File đính kèm

PHP:
1    If sRng Is Nothing Then
        MsgBox "Nothing"
3    Else
        Target.Offset(, 1).Resize(, 2).Value = sRng.Offset(, 1).Resize(, 2).Value
5    End If

Câu lệnh bên trên đoạn trích dẫn là tìm sRng;
C1: Nếu không tìm thấy (sRng) thì
C2: Báo tôi biết bằng câu chữ "Nothing"
C3: Bằng ngược lại (Tìm thấy)
. . . . .
 
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
    Const GD As String = "_"            '<=|'
    
    Set Sh = ThisWorkbook.Worksheets("MA")
    Set Rng = Sh.Range(Sh.[b2], Sh.[b2].End(xlDown))
    Set sRng = Rng.Find(GD & 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

Thử xem sao nha bạn!
Cái chú thích này '<=|'
Có phải là chỉ cho từng bản ghi một, e copy cả đoạn luôn thì báo lỗi ạh, vậy giải pháp là gì?

 

File đính kèm

  • run time error.jpg
    run time error.jpg
    10.7 KB · Đọc: 251
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
    Const GD As String = "_"            '<=|'
    
    Set Sh = ThisWorkbook.Worksheets("MA")
    Set Rng = Sh.Range(Sh.[b2], Sh.[b2].End(xlDown))
    Set sRng = Rng.Find(GD & 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

Thử xem sao nha bạn!
E bôi đen một mảng mã, copy vào Range B2:B99 thì báo lỗi ạh, có giải pháp nào tốt hơn ko ạh
 

File đính kèm

  • run time error.jpg
    run time error.jpg
    10.7 KB · Đọc: 248
E bôi đen một mảng mã, copy vào Range B2:B99 thì báo lỗi ạh, có giải pháp nào tốt hơn ko ạh
Đưa nguyên cái file bị lỗi lên xem sao. Nói rõ khi nào thì lỗi.
Chỉ đọc được đoạn code đó nhưng có biết file nó ra sao đâu mà kiểm tra. Híc!
 
Thật ra tôi rất thích tranh luận để chứng minh vấn đề
Vậy thay vì nói suông ta làm cuộc thí nghiệm với 10000 dòng dữ liệu giữa code của tôi VS với VLOOKUP nhé (xem file)
Tại sheet ChiTiet, điền dữ liệu vào cột C rồi lookup 16 cột còn lại bên phải
Code của tôi như sau:
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rTarget As Range, aTarget, i As Long, j As Long, n As Long, TG As Double
  Dim Arr(), tmp
  On Error Resume Next
  TG = Timer
  If Dic Is Nothing Then Auto_Open
  If Not Intersect(Range("C6:C65536"), Target) Is Nothing Then
    Set rTarget = Intersect(Range("C6:C65536"), Target)
    If IsArray(rTarget.Value) Then
      aTarget = rTarget.Value
    Else
      ReDim aTarget(1 To 1, 1 To 1)
      aTarget(1, 1) = rTarget.Value
    End If
    ReDim Arr(1 To UBound(aTarget, 1), 1 To 17)
    For i = 1 To UBound(aTarget, 1)
      If aTarget(i, 1) <> "" Then
        tmp = aTarget(i, 1)
        If Dic.Exists(tmp) Then
          For j = 2 To 17
            Arr(i, j - 1) = aResult(Dic.Item(tmp), j)
          Next
        End If
      End If
    Next
    rTarget.Offset(, 1).Resize(, 16).Value = Arr
    MsgBox Timer - TG
  End If
End Sub

Bác ndu cho em hỏi nếu sử dụng code này nhưng số luợng tới 170.000 dòng thì phải sửa sao vậy ta? em thử sửa C6:C65536 --> C6:C170000 nhưng chẳng ăn thua, khi copy/paste như hướng dẫn thì từ dòng 117.000 trở đi nó ko ra kết quả nữa
 
Bác ndu cho em hỏi nếu sử dụng code này nhưng số luợng tới 170.000 dòng thì phải sửa sao vậy ta? em thử sửa C6:C65536 --> C6:C170000 nhưng chẳng ăn thua, khi copy/paste như hướng dẫn thì từ dòng 117.000 trở đi nó ko ra kết quả nữa

Tôi thấy code của Ndu có tác dụng tới dòng thứ 65536 nên bạn cứ thế mà xài, chẳng cần phải sửa gì cả.
 
Đúng là em không xem kỹ, do dùng Ex 2003 nên cứ tưởng 65.536 là lớn nhất. Vậy sai ở đâu ta ? (Ex 2003 không test được)
 
Lần chỉnh sửa cuối:
Xin chào các Anh Chị GPE,

Sau khi đọc chủ đề này mình có câu hỏi thế này.

- File của anh "ndu96081631": Khi mình thay đổi nội dung ở Sheet LLNV thì Sheet Chi Tiết không tự động chạy theo nội dung mới mà phải F2 cột mã NV rồi Enter thì giá trị mới cập nhật.>> Mình muốn nó tự động cập nhật như Vlookup luôn.
- Trong trường hợp này là Data chung 1 file excel, nếu như Sheet LLNV nằm trong 1 file khác (Ví dụ có tên DATA.xls) thì code mình phải thay đổi thế nào ạ.

Mong các Anh Chị GPE giải đáp giúp nha.

Cảm ơn Anh Chị rất nhiều.
 

File đính kèm

Xin chào các Anh Chị GPE,

Sau khi đọc chủ đề này mình có câu hỏi thế này.

- File của anh "ndu96081631": Khi mình thay đổi nội dung ở Sheet LLNV thì Sheet Chi Tiết không tự động chạy theo nội dung mới mà phải F2 cột mã NV rồi Enter thì giá trị mới cập nhật.>> Mình muốn nó tự động cập nhật như Vlookup luôn.
- Trong trường hợp này là Data chung 1 file excel, nếu như Sheet LLNV nằm trong 1 file khác (Ví dụ có tên DATA.xls) thì code mình phải thay đổi thế nào ạ.

Mong các Anh Chị GPE giải đáp giúp nha.

Cảm ơn Anh Chị rất nhiều.

yêu câu thứ 1: khi thay đổi bất kỳ bên sheet "LLNV" thì sheet "chitiet" cập nhật theo (giống tính năng của hàm vlookup)
cái này có thể sử dụng find method trong sự kiện worksheet change cho sheet "LLNV"
tuy nhiên cho hỏ là: các mã cột C của sheet "chi tiet" có trùng nhau ko?

câu hỏi 2: nếu nằm ở file khác thì phức tạp hơn là phải mở file đó ra rồi dùng phương pháp Find
(hoặc dùng ADO, cái này thì tôi chỉ biết là vậy chứ chưa biết làm)
 
yêu câu thứ 1: khi thay đổi bất kỳ bên sheet "LLNV" thì sheet "chitiet" cập nhật theo (giống tính năng của hàm vlookup)
cái này có thể sử dụng find method trong sự kiện worksheet change cho sheet "LLNV"
tuy nhiên cho hỏ là: các mã cột C của sheet "chi tiet" có trùng nhau ko?

câu hỏi 2: nếu nằm ở file khác thì phức tạp hơn là phải mở file đó ra rồi dùng phương pháp Find
(hoặc dùng ADO, cái này thì tôi chỉ biết là vậy chứ chưa biết làm)

- Trong trường hợp của em thì có, mã code sẽ được lặp lại nhiều lần, phần này em chỉ cần nó auto update như vlookup là ok.
- Cũng có nghe nói ADO nhưng không biết nó thế nào luôn. :). Mong các Anh Chị chỉ giáo, nếu mà có thể chọn file làm data như trong Vlookup thì hay biết mấy (Vlookup xong mình có thể chọn Edit link và chọn vào 1 file khác tương tự). Vì File Data của em mỗi khi cập nhật giá là thêm 1 số (Ví dụ Data1 , Data2 ....)
 
- Trong trường hợp của em thì có, mã code sẽ được lặp lại nhiều lần, phần này em chỉ cần nó auto update như vlookup là ok.
- Cũng có nghe nói ADO nhưng không biết nó thế nào luôn. :). Mong các Anh Chị chỉ giáo, nếu mà có thể chọn file làm data như trong Vlookup thì hay biết mấy (Vlookup xong mình có thể chọn Edit link và chọn vào 1 file khác tương tự). Vì File Data của em mỗi khi cập nhật giá là thêm 1 số (Ví dụ Data1 , Data2 ....)

yêu cầu thứ 1 (để điều chỉnh lại vị trí các cột)
 

File đính kèm

Lần chỉnh sửa cuối:
Trong file của anh, khi thay đổi Tên thì ok, có thể thay đổi theo, nhưng khi thay đổi Ngày vào bên LLNV thì cột mã code bên sheet Chi Tiet chạy số tùm lum.
Anh fix lại giúp.

lúc chiều tôi mới test xong một c ột, như hết giờ làm nên đi về...........post lên đó về nhà làm tiếp
đã làm lại cho bạn,....vào test thử
=================
nếu bạn có tải về thì bỏ dùm tôi 2 dòng lệnh
Mã:
Sub update()
[COLOR=#ff0000]Application.ScreenUpdating = False[/COLOR]
.......................................................
[COLOR=#ff0000]Application.ScreenUpdating = True[/COLOR]
End Sub
ở sub update, nó ko giúp ích gì, chỉ gây màn hình giật giật
 
Lần chỉnh sửa cuối:
lúc chiều tôi mới test xong một c ột, như hết giờ làm nên đi về...........post lên đó về nhà làm tiếp
đã làm lại cho bạn,....vào test thử
=================
nếu bạn có tải về thì bỏ dùm tôi 2 dòng lệnh
Mã:
Sub update()
[COLOR=#ff0000]Application.ScreenUpdating = False[/COLOR]
.......................................................
[COLOR=#ff0000]Application.ScreenUpdating = True[/COLOR]
End Sub
ở sub update, nó ko giúp ích gì, chỉ gây màn hình giật giật

Hi Anh,

Hiện tại em thấy Form này ổn rồi đó, Cảm ơn anh, nhưng có thể rút gọn phần nào ko anh? vì trong Form của em quá trời module và Sub.

Anh cho em hỏi là file có nhiều Module và Sub thì có ảnh hưởng đến tốc độ của file ko?
 
Xin chào Anh Chị GPE,

Em up lại file bữa trước, em thay đổi cột CMND >> Thành tiền.

Nhờ anh chị xem giúp,
1- em muốn chổ cột thành tiền là nó tự lấy giá * với cột Cân nặng luôn (Giá tại cột thành tiền là giá từ Data (LLNV) * cân nặng). Cột Cân nặng là mình tự đánh vào, khi cân nặng thay đổi thì giá tại cột thành tiền sẽ tự độnng thay đổi theo.
2- Đối với những số thẻ bắt đầu = dấu #, em muốn nó hiện những dòng phụ bên dưới thôi, chú ko hiện dòng chính
Ví dụ : mã thẻ #6012 của Đinh Văn Tịnh (DVT). bên Chi Tiết khi em đánh #6012 thì em chỉ muốn hiện thông tin 2 dòng Đinh Văn A, và Nguyễn Xuân Tuyên. Tương tự với #6013.
Mong anh chị xem giúp có cách nào mà thể hiện được như vậy ko nha.

Cảm ơn anh chị rất nhiều.
 

File đính kèm

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

Xin hỏi bạn rằng nếu mình có nhiều sheet như CT1, CT2, CT3.... thì viết code cho các sheet ấy để tìm kiếm bên sheet "MA" như thế nào? ở các vị trí khác ví dụ như cột H, I đến K, L, M (sheet("MA")) cột AF đến AJ (sheet CT1, CT2....) nhưng cột sheet "MA" thì không có cột j mà sheet CT thì các cột liền nhau chẳng hạn
Mình còn kém mong được giúp đỡ
Cám ơn
 
Lần chỉnh sửa cuối:
Em đã thử áp dụng code của anh CONCOGIA mà không được. Mong các anh giúp đỡ em ạ.
 

File đính kèm

Lần chỉnh sửa cuối:
Sửa code bài 45 lại tí thôi mà (sửa tham chiếu cho phù hợp dữ liệu của bạn)
Xem file
Cảm ơn bác rất nhiều về code này. Nhưng em thay vì nhập liệu vào sheet CT mà em có danh sách sẵn từ copy - pate vào nó ko chạy được anh ạ, phải nhấn F2 sửa rồi enter nó mới ra. Bác xem giúp em sửa thế nào với ạ
 
mò mấy ngày rồi cũng chưa hiểu gì, tuy nhiên xào nấu mò theo ý được rồi, chỉ còn 1 thắc mắc là cái library mình để ở 1 workbook khác được không? vì cái đó thường liên quan đến dữ lieu giá của công ty, không tiện gửi file lên, các anh chị thhông cảm cho hỏi chay thôi ạ
 
mò mấy ngày rồi cũng chưa hiểu gì, tuy nhiên xào nấu mò theo ý được rồi, chỉ còn 1 thắc mắc là cái library mình để ở 1 workbook khác được không? vì cái đó thường liên quan đến dữ lieu giá của công ty, không tiện gửi file lên, các anh chị thhông cảm cho hỏi chay thôi ạ
Tôi chưa hiểu ý bạn muốn hỏi j
thôi thì đoán mò, có phải bạn có 1 thư viện (trong 1 workbook), yêu câu tìm kiếm các mã theo thư viện đó?
vậy từ workbook đó có thể xây dựng 1 hàm tự tạo rồi biến nó thành addins, rồi sau cứ thế sử dụng.
 
chính xác vậy đó bạn cá ngừ F1, nhưng do không biết viết nên đành nhờ mọi người giúp
 
mình chỉnh lại cái nguồn vì lí do cá nhân nha, @#!^%, chỉ là mỗi lần tính giá xong lại phải ngồi xóa công thức, xóa bang giá ....,
giờ trước tiên chỉ muốn vlookup cái diễn giải trước thôi
 
Lần chỉnh sửa cuối:
mình chỉnh lại cái nguồn vì lí do cá nhân nha, @#!^%, chỉ là mỗi lần tính giá xong lại phải ngồi xóa công thức, xóa bang giá ....,
giờ trước tiên chỉ muốn vlookup cái diễn giải trước thôi
Bạn thử dùng code này xem sao:
Mã:
Sub TimKiem()


    Dim i&, Rng As Range, Data(), DienGiai()
    
    Data = Range(Sheet9.[A24], Sheet9.[A1000].End(3))
    ReDim DienGiai(1 To UBound(Data), 1 To 1)
    
    For i = 1 To UBound(Data)
    
        Set Rng = Sheet11.[B2:B50].Find(Data(i, 1), , , 1)
        
        If Not Rng Is Nothing Then
            
            DienGiai(i, 1) = Rng.Offset(, 2)
        
        End If
    
    Next
    Sheet9.[B24].Resize(i - 1, 1) = DienGiai


End Sub

P/s: bạn nghiên cứu để tìm kiếm thêm các cột khác, chúc bạn thành công...
 
Em thử áp dụng các code trong bài nhưng vẫn chưa dùng được như hàm vlookup

Em có 1 sheet khai báo nhân viên tương ứng ở nhóm nào

Em muốn khi nhập liệu chỉ nhập tên nhân viên thì cột nhóm tự động lấy bên sheet khai báo

Chi tiết ở file đính kèm

Kính nhờ anh chị hỗ trợ giúp em với ah

Em cám ơn
 

File đính kèm

Em thử áp dụng các code trong bài nhưng vẫn chưa dùng được như hàm vlookup

Em có 1 sheet khai báo nhân viên tương ứng ở nhóm nào

Em muốn khi nhập liệu chỉ nhập tên nhân viên thì cột nhóm tự động lấy bên sheet khai báo

Chi tiết ở file đính kèm

Kính nhờ anh chị hỗ trợ giúp em với ah

Em cám ơn

Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
If Not Intersect(Target, [b4:b100]) Is Nothing Then
 Set rng = Sheets("Boloc").[b:b].Find(Target, , , 1)
 If Not rng Is Nothing Then Target.Offset(, 1) = rng.Offset(, 1)
End If
End Sub
chép vào sheet 2
 
Nhờ các bạn rành VBA giúp dùm cái này chút nha @$@!^%, trình của mình chỉ dừng ở record macro thôi nên array đọc không hiểu gì hết +-+-+-+, với file VD gửi kèm với các yêu cầu sau@#!^%

1. Vlookup chu vi của sheet data vào các sheet tổng hợp của từng dự án (ở đây mình xin xóa bớt thông tin nhé), thực sự thì số sheet dự án sẽ được thêm dần, số dòng của dự án lớn hơn VD rất nhiều

2. sheet data và các dòng code có thể chỉ lưu ở dạng .xla được không? vì yêu cầu công việc thôi, nếu không được cũng không sao vì sẽ xóa tay sheet data

3. khi có dự án mới thì add sheet dự án mới vào file VD và chạy code để vlookup chu vi

cám ơn mọi người?>
 
Macro của bạn đây:
PHP:
Option Explicit
Sub VLookUp()
 Dim Sh As Worksheet, CSDL As Range, Cls As Range
 Dim Rws As Long
 
 Set Sh = ThisWorkbook.Worksheets("DATA")
 
 Set CSDL = Sh.[B2].CurrentRegion
 If [B2].Parent.Name = "DATA" Then
    MsgBox "Hay Chon Trang Khác!":                  Exit Sub
 End If
 For Each Cls In Range([c4], [c4].End(xlDown))
    Cls.FormulaR1C1 = _
        "=IF(TYPE(VLOOKUP(RC[-1],DATA!R2C1:R27C4,2,0))=16,"""",VLOOKUP(RC[-1],DATA!R2C1:R27C4,2,0))"
 Next Cls
End Sub

Những mong là bạn biết chạy macro này ở các trang tính cần thiết cho bạn.
Bổ sung: Khi nào CSDL ở trang 'DATA' tăng bạn sẽ fải sửa lại các số đang là 27 tăng tương ứng.
 
Chỉnh sửa lần cuối bởi điều hành viên:
tình hình là rất tình hình bạn HYen17 ạ
mình chép cái code của bạn vào, đứng ở sheet dự án, chạy êm ru nhưng không ra kết quả
đứng ở sheet data chạy ra thông báo chọn sheet khác, ok xong vẫn êm ru?
bạn có thể viết giúp mình dạng array phía trên không?

làm phiền bạn quá.+-+-+-+
 

Bài viết mới nhất

Back
Top Bottom