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

HieuCD · 9/12/18

havuhoang đã viết:
Sao mình dùng code nay nếu mã hành hóa lá chữ vd như A,B,C,D.. thì ok nhưng khi mã hàng là số thì khg dc. Mong các bác chỉ giáo. Mình khg lót file đc

Chuyển Key về dạng chuỗi, chỉnh lại tí tẹo
d.Add UCase(Vung(I, 1)), Array(Vung(I, 2), Vung(I, 3))

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 UCase(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

cõi ta bà · 26/5/19

concogia đã viế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

Xin hỏi các anh chị nếu tên sheet có dấu thì sửa code này thế nào ạ

Hoàng Nhật Phương · 26/5/19

.........................

cõi ta bà · 26/5/19

Nguyễn Hoàng Oanh Thơ đã viết:
Tên sheet là gì thế bạn?

tên sheet là ngạch sớ thì sửa làm sao ạ

Ba Tê · 26/5/19

cõi ta bà đã viết:
tên sheet là ngạch sớ thì sửa làm sao ạ

Sửa thành "Ngach_So"
Hay thành Ronaldo, Trump, Luxubu... gì đó miễn không có dấu tiếng Việt là được.

cõi ta bà · 26/5/19

Ba Tê đã viết:
Sửa thành "Ngach_So"
Hay thành Ronaldo, Trump, Luxubu... gì đó miễn không có dấu tiếng Việt là được.

Sửa file nguồn hả anh. hay sửa trong vba ạ. xin cảm ơn

Ba Tê · 26/5/19

cõi ta bà đã viết:
Sửa file nguồn hả anh. hay sửa trong vba ạ. xin cảm ơn

Sửa cả 2, trong file tên sheet là gì thì viết trong VBA "y chang" vậy.

cõi ta bà · 26/5/19

Ba Tê đã viết:
Sửa cả 2, trong file tên sheet là gì thì viết trong VBA "y chang" vậy.

khổ nỗi tên sheet của em có dấu thì viết làm sao ạ

Hoàng Nhật Phương · 26/5/19

cõi ta bà đã viết:
Sửa file nguồn hả anh. hay sửa trong vba ạ. xin cảm ơn

Sửa tại dòng, chỗ chữ màu đỏ kìa bạn, sửa theo tên sheet không dấu mà bạn đặt ấy:
Set Ws = Sheets("MA")

Bạn sửa thành:
Set Ws = Sheets("Ngach_So")

--------

Cũng có nhiều cách như: Lấy theo tên sheet,lấy theo thứ tự sheet, lấy theo tên của đối tượng worksheet trong VBA.
Bạn tham khảo link:
https://www.giaiphapexcel.com/diendan/threads/bài-5-workbook-worksheet.130566/

--------

cõi ta bà đã viết:
khổ nỗi tên sheet của em có dấu thì viết làm sao ạ

Nếu cứ nhất thiết phải đưa tên sheet có dấu ("ngạch sớ") vào code thì bạn sửa/ bổ sung các chỗ màu đỏ như sau:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim d, I, Vung, Ws
Dim tensheet As String
tensheet = "ng" & ChrW(7841) & "ch s" & ChrW(7899) 'ngạch sớ
Set d = CreateObject("scripting.dictionary")
Set Ws = Sheets(tensheet)
Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 3)
...
End Sub

Ba Tê · 26/5/19

cõi ta bà đã viết:
khổ nỗi tên sheet của em có dấu thì viết làm sao ạ

Tôi không biết cách nào. Thua luôn.

Hoàng Nhật Phương · 26/5/19

Ba Tê đã viết:
Tôi không biết cách nào. Thua luôn.

Con chào Thầy,
Có lẽ là Thầy "ngại" vì có thể sẽ phát sinh thêm nhiều câu hỏi khác ạ

cõi ta bà · 26/5/19

Ba Tê đã viết:
Tôi không biết cách nào. Thua luôn.

Dạ xin cám ơn nhiều

Bài đã được tự động gộp: 26/5/19

Nguyễn Hoàng Oanh Thơ đã viết:
Sửa tại dòng, chỗ chữ màu đỏ kìa bạn, sửa theo tên sheet không dấu mà bạn đặt ấy:
Set Ws = Sheets("MA")

Bạn sửa thành:
Set Ws = Sheets("Ngach_So")

--------

Cũng có nhiều cách như: Lấy theo tên sheet,lấy theo thứ tự sheet, lấy theo tên của đối tượng worksheet trong VBA.
Bạn tham khảo link:
https://www.giaiphapexcel.com/diendan/threads/bài-5-workbook-worksheet.130566/

--------

Nếu cứ nhất thiết phải đưa tên sheet có dấu ("ngạch sớ") vào code thì bạn sửa/ bổ sung các chỗ màu đỏ như sau:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim d, I, Vung, Ws
Dim tensheet As String
tensheet = "ng" & ChrW(7841) & "ch s" & ChrW(7899) 'ngạch sớ
Set d = CreateObject("scripting.dictionary")
Set Ws = Sheets(tensheet)
Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 3)
...
End Sub

xin bác cho code hoàn chỉnh ạ. xin cám ơn

Ba Tê · 26/5/19

Nguyễn Hoàng Oanh Thơ đã viết:
Con chào Thầy,
Có lẽ là Thầy "ngại" vì có thể sẽ phát sinh thêm nhiều câu hỏi khác ạ

"Có lẽ..." đã được trả lời!

Hoàng Nhật Phương · 26/5/19

cõi ta bà đã viết:
xin bác cho code hoàn chỉnh ạ. xin cám ơn

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim d, I, Vung, Ws
    Dim tensheet As String
    tensheet = "ng" & ChrW(7841) & "ch s" & ChrW(7899)
    Set d = CreateObject("scripting.dictionary")
    Set Ws = Sheets(tensheet)
    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

cõi ta bà · 26/5/19

Nguyễn Hoàng Oanh Thơ đã viết:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim d, I, Vung, Ws
    Dim tensheet As String
    tensheet = "ng" & ChrW(7841) & "ch s" & ChrW(7899)
    Set d = CreateObject("scripting.dictionary")
    Set Ws = Sheets(tensheet)
    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

Dạ xin cảm ơn nhưng nó vẫn báo lỗi ạ

Hoàng Nhật Phương · 26/5/19

cõi ta bà đã viết:
Dạ xin cảm ơn nhưng nó vẫn báo lỗi ạ

Bạn có thể gửi file kèm của bạn lên đây được không ạ?
OT thấy bạn có vẻ chưa biết một chút nào về code nên cũng thấy khó có thể giải thích để bạn hiểu quá.

cõi ta bà · 26/5/19

Nguyễn Hoàng Oanh Thơ đã viết:
Bạn có thể gửi file kèm của bạn lên đây được không ạ?
OT thấy bạn có vẻ chưa biết một chút nào về code nên cũng thấy khó có thể giải thích để bạn hiểu quá.

dạ đây ạ

Hoàng Nhật Phương · 26/5/19

cõi ta bà đã viết:
dạ đây ạ

Bởi vì trong sheet "Ngạch sớ" bạn để 2 từ khóa tìm kiếm("B") trong cột B giống nhau.
Từ khóa trong cột B này phải là duy nhất chứ bạn.

cõi ta bà · 26/5/19

Nguyễn Hoàng Oanh Thơ đã viết:
Bởi vì trong sheet "Ngạch sớ" bạn để 2 từ khóa tìm kiếm("B") trong cột B giống nhau.
Từ khóa trong cột B này phải là duy nhất chứ bạn.

dạ xin cảm ơn thật tuyệt. Xin hỏi có cách nào làm trên Module không ạ

HieuCD · 26/5/19

Nguyễn Hoàng Oanh Thơ đã viết:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim d, I, Vung, Ws
    Dim tensheet As String
    tensheet = "ng" & ChrW(7841) & "ch s" & ChrW(7899)
    Set d = CreateObject("scripting.dictionary")
    Set Ws = Sheets(tensheet)
    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

Bỏ Dic được không bạn

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

Chuyên gia GPE

Thành viên mới

Thành viên gắn bó

Thành viên mới

Cạo Rồi Khỏi Gội

Thành viên mới

Cạo Rồi Khỏi Gội

Thành viên mới

Thành viên gắn bó

Cạo Rồi Khỏi Gội

Thành viên gắn bó

Thành viên mới

Cạo Rồi Khỏi Gội

Thành viên gắn bó

Thành viên mới

Thành viên gắn bó

Thành viên mới

File đính kèm

Thành viên gắn bó

Thành viên mới

Chuyên gia GPE

Facebook

Group