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

Liên hệ QC
tueyennhi đã viết:
Hay quá, lại thêm một kiến thức cần thiết. Thầy ndu96081631 cho em hỏi thêm: Như vậy là các sheet tương tự muốn lấy như sheet chitiet là ta đều phải chèn code vào sheet đó đúng không ạ?
Nhấp chuột vào đây để mở rộng...

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 ở đó
 
ndu96081631 đã viết:
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 ở đó
Nhấp chuột vào đây để mở rộng...

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.
 
ndu96081631 đã viết:
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

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
Nhấp chuột vào đây để mở rộng...
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 ạ.
 
ndu96081631 đã viết:
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 ở đó
Nhấp chuột vào đây để mở rộ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?
 
tueyennhi đã viế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?
Nhấp chuột vào đây để mở rộng...

Thử dùng trong This Workbook
Mã: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

End Sub
 
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 ạ
 

File đính kèm

  • Record Ticket_NgoVuongThong.xlsx
    178 KB · Đọc: 21
concogia đã viết:
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
Nhấp chuột vào đây để mở rộng...

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
 
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 ạ.
 
ndu96081631 đã viết:
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)
Nhấp chuột vào đây để mở rộng...

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
 
ndu96081631 đã viết:
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 ở đó
Nhấp chuột vào đây để mở rộng...
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 đã viế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
Nhấp chuột vào đây để mở rộng...
@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 đã viết:
@truongvu317 sao tớ không thấy nick cậu sáng nhỉ? Tớ vừa thấy cậu post bài xong.
Nhấp chuột vào đây để mở rộng...
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.
 
truongvu317 đã viết:
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.
Nhấp chuột vào đây để mở rộng...
Ẩ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 đã viế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
Nhấp chuột vào đây để mở rộng...
Anh chị có teamviewer vào giúp em với ạ.
 
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
Nhấp chuột vào đây để mở rộng...
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
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

LuuAnh980
  • Question
Code lấy dữ liệu từ 3 file con.
2 3
Trả lời
52
Đọc
619
LuuAnh980
LuuAnh980
S
  • Question
Không lấy đủ dữ liệu bằng kết nối ADO
2
Trả lời
21
Đọc
377
ongke0711
ongke0711
S
Slicer không chuyển qua trạng thái mờ.
Trả lời
2
Đọc
62
SteveNguyen1991
S
H
Kết nối vba với Database host (hiện tại đang làm host web)
Trả lời
2
Đọc
132
Haidang7979
H
emlat3
Đặt màu xen kẽ các dòng theo ký tự
Trả lời
1
Đọc
55
DeTong
D
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom