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

[tueyennhi]

Lâu quá quên mất tiêu rồi bạn ơi!
Muốn gì cứ việc thử nghiệm, trục trặc ở đâu ta giải quyết ở đó

Em làm thì làm thử nghiệm hết rồi, hiện tại để dùng được ở sheet nào em phải chèn code vào sheet đó. Em có đọc qua về vụ chèn vào module nhưng vẫn phải cần code phụ ở sheet cần chạy.

 

[Gà Công Nghệ]

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:

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:

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

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

Thầy cho em hỏi, khi tìm được mã ở sheet chi tiết, mình muốn lưu sheet chi tiết này sang sheet mới (sheet 3), rồi mình tìm tiếp và lưu sang sheet mới (sheet 4)... thì dùng code như thế nào ạ (nếu có thể lưu sang sheet khác thì vẫn canh chuẩn trang in ở sheet chi tiết). Em xin cám ơn ạ.

 

[tueyennhi]

Lâu quá quên mất tiêu rồi bạn ơi!
Muốn gì cứ việc thử nghiệm, trục trặc ở đâu ta giải quyết ở đó

À là như vầy thầy ndu96081631 ạ, không có một trục trặc nhỏ nào ngoài chuyện mỗi sheet cần chạy được code trên thì đều phải chèn code vào chính sheet đó. Có cách nào mà thay vì để code trong sheet ta để vào một chỗ khác mà dùng cho toàn bộ các sheet không thầy?

 

[Gió Đông]

À là như vầy thầy ndu96081631 ạ, không có một trục trặc nhỏ nào ngoài chuyện mỗi sheet cần chạy được code trên thì đều phải chèn code vào chính sheet đó. Có cách nào mà thay vì để code trong sheet ta để vào một chỗ khác mà dùng cho toàn bộ các sheet không thầy?

Thử dùng trong This Workbook

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

End Sub

 

[tueyennhi]

Thử dùng trong This Workbook

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

End Sub

À được rồi, mình cũng có ý tưởng đó nhưng dòng Private Sub Worksheet giữ nguyên, đổi sang Private Sub Workbook là được. Cảm ơn winvista

 

[Ngô Vương Thông]

Xin chào anh/chị , em vừa mới tham gia diễn đàn , có viết bài chưa đúng nội quy hoặc chưa chuẩn như yêu cầu của Forum thì mong anh/chị bỏ qua giúp em ạ

Em có bảng tính gồm 3 sheet như sau :

- Sheet "Record Ticket" là sheet chính để em thao tác làm báo cáo -
- Sheet "Vlookup Data" là sheet em dùng để tham chiếu cho các colum ở sheet "Record Ticket" -
- Sheet "Phân Loại-Cập Nhật Ticket" là sheet em dùng để tìm kiếm và phân loại lỗi Ticket -

Em xin các anh/chị hỗ trợ em trường hợp sau ạ :

- Ở Sheet "Record Ticket" em đang sử dụng hàm "Vlookup" ở Colum "G"-"H"-"I" (Chú thích : khi em nhập tay "Code NPP" ở Colum 'H' thì "Mail" ở Colum 'G' và "Tên NPP" ở Colum 'I' sẽ tự hiện ra nhờ tham chiếu bằng hàm Vlookup).

-> Các anh/chị có thể hỗ trợ em thay thế hàm Vlookup bằng code VBA được không ạ ? <-
-> Các anh/chị có thể tùy biến như thế nào để em có thể nhập liệu nhanh chóng được không ạ ? <-

-----[Em có một ý tưởng là : Ở Sheet "Record Ticket" khi em nhập liệu vào Colum "L" (Nhóm Ticket) thì Colum "M" (Loại Ticket) cũng sẽ nhảy dữ liệu theo hoặc ngược lại] được không ạ ?-----

Em có hide đi 2 sheet ở chế độ bình thường , các anh/chị nào cần dữ liệu thêm thì unhide 2 sheet đó ra nhé .

Em xin cám ơn anh/chị , rất mong anh chị hỗ trợ em trường hợp này ạ

 

[Jokerfly]

Bạn chép code này đè lên cái cũ nhé

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

Vậy mình muốn xuất 1 Msgbox " khong tim thay du lieu" nếu dữ liệu nhập không nằm trong sheet MA thì sao bạn mình mò vẫn chưa ra

 

[leduongfhs]

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é

Anh Ơi giúp em với: bây giờ thêm 1 cột"CỘT MỚI" Ở CỘT S thì sửa code như thế nào ạ? Em cảm ơn nhiều ạ

 

[phiyen8902]

Thầy ndu96081631 cho em hỏi thêm về file thực hành 3. Bây giờ em muốn thêm 3 sheet giống như sheet LLNV thì phải làm như thế nào để lấy dữ liệu của tất cả các sheet đó? Vd: sheet A, sheet B, sheet C, sheet D... sheet chitiết thì vẫn là 1 nhưng do vi trí các cột của sheet A, sheet B, sheet C, sheet D... lại không giống như sheet LLNV. Em cám ơn nhìu ạ.

 

[LamNA]

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

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)

Private Sub Worksheet_Change(ByVal Target As Range)
  Chk = True
End Sub

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

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)

Chào Thầy
Em đã thử và chạy rất nhanh và hiệu quả, tuy nhiên em muốn thêm 1 điều kiện nếu không thỏa mãn điều kiện tham chiếu mặc định nó sẽ hiển thị trống ( tức trong sheet LLNV không có mã số thẻ tham chiếu của số thẻ sheet chi tiết ), thì nó hiển thị là "Khác" có được không thầy?
Mục đích nhầm trong vận hành khi nhập model mới từ nhà cung cấp các mã hàng mới chưa cập nhật trong DATA SẢN PHẨM mình dựa vào đó sẽ biết và cập nhật thêm.
Em cám ơn

 

[van_utc]

Lâu quá quên mất tiêu rồi bạn ơi!
Muốn gì cứ việc thử nghiệm, trục trặc ở đâu ta giải quyết ở đó

Em chào các bạn GPE.
Em có file dữ liệu cần lọc với khoảng 160.000 dòng (và sẽ còn tăng ạ) muốn nhờ các anh chị làm giúp em VBA vì hiện tại em làm bằng VLOOKUP rất cực ạ.
Do file quá nặng, nên em nén còn gần 24MB và up lên mediafire ạ.
Em cảm ơn các anh chị!
Link:
http://www.mediafire.com/file/oo38c1j42eizm3a/BaoCaoHangChiTiet.rar

 

[van_utc]

Em chào các bạn GPE.
Em có file dữ liệu cần lọc với khoảng 160.000 dòng (và sẽ còn tăng ạ) muốn nhờ các anh chị làm giúp em VBA vì hiện tại em làm bằng VLOOKUP rất cực ạ.
Do file quá nặng, nên em nén còn gần 24MB và up lên mediafire ạ.
Em cảm ơn các anh chị!
Link:
http://www.mediafire.com/file/oo38c1j42eizm3a/BaoCaoHangChiTiet.rar

@yeudoi giúp em với ạ.

 

[van_utc]

Em chào các bạn GPE.
Em có file dữ liệu cần lọc với khoảng 160.000 dòng (và sẽ còn tăng ạ) muốn nhờ các anh chị làm giúp em VBA vì hiện tại em làm bằng VLOOKUP rất cực ạ.
Do file quá nặng, nên em nén còn gần 24MB và up lên mediafire ạ.
Em cảm ơn các anh chị!
Link:
http://www.mediafire.com/file/oo38c1j42eizm3a/BaoCaoHangChiTiet.rar

@Ba Tê giúp em với ạ.

 

[van_utc]

Em chào các bạn GPE.
Em có file dữ liệu cần lọc với khoảng 160.000 dòng (và sẽ còn tăng ạ) muốn nhờ các anh chị làm giúp em VBA vì hiện tại em làm bằng VLOOKUP rất cực ạ.
Do file quá nặng, nên em nén còn gần 24MB và up lên mediafire ạ.
Em cảm ơn các anh chị!
Link:
http://www.mediafire.com/file/oo38c1j42eizm3a/BaoCaoHangChiTiet.rar

@truongvu317 sao tớ không thấy nick cậu sáng nhỉ? Tớ vừa thấy cậu post bài xong.

 

[van_utc]

Em chào các bạn GPE.
Em có file dữ liệu cần lọc với khoảng 160.000 dòng (và sẽ còn tăng ạ) muốn nhờ các anh chị làm giúp em VBA vì hiện tại em làm bằng VLOOKUP rất cực ạ.
Do file quá nặng, nên em nén còn gần 24MB và up lên mediafire ạ.
Em cảm ơn các anh chị!
Link:
http://www.mediafire.com/file/oo38c1j42eizm3a/BaoCaoHangChiTiet.rar

@HieuCD giúp em với ạ.

 

[truongvu317]

@truongvu317 sao tớ không thấy nick cậu sáng nhỉ? Tớ vừa thấy cậu post bài xong.

Tớ ẩn trạng thái thì làm sao mà thấy được, mà không được đăng nhiều bài liên tục như trên, dễ bị coi là spam, rồi chặn nick cho mà xem rồi kêu khổ. Trên gpe này cứ yên tâm một điều là để bài rõ ràng thì chắc chắn những thành viên có khả năng giúp sẽ giúp.

 

[van_utc]

Tớ ẩn trạng thái thì làm sao mà thấy được, mà không được đăng nhiều bài liên tục như trên, dễ bị coi là spam, rồi chặn nick cho mà xem rồi kêu khổ. Trên gpe này cứ yên tâm một điều là để bài rõ ràng thì chắc chắn những thành viên có khả năng giúp sẽ giúp.

Ẩn ở chỗ nào ấy cậu nhỉ? Cậu vào xem giúp tớ với. File nặng quá, mỗi lần mở ra đợi lâu, lúc chạy còn treo máy luôn.

 

[van_utc]

Em chào các bạn GPE.
Em có file dữ liệu cần lọc với khoảng 160.000 dòng (và sẽ còn tăng ạ) muốn nhờ các anh chị làm giúp em VBA vì hiện tại em làm bằng VLOOKUP rất cực ạ.
Do file quá nặng, nên em nén còn gần 24MB và up lên mediafire ạ.
Em cảm ơn các anh chị!
Link:
http://www.mediafire.com/file/oo38c1j42eizm3a/BaoCaoHangChiTiet.rar

Anh chị có teamviewer vào giúp em với ạ.

 

[havuhoang]

Mã nó đây
RightClick vào sheet "CT" ==> View Code chép cái này vào

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

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

 

[HieuCD]

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))

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