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

Liên hệ QC
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?
 
tr hoan đã viết:
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?
Nhấp chuột vào đây để mở rộng...
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.
 
khongphai02 đã viết:
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.
Nhấp chuột vào đây để mở rộng...

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ã

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

  • vlookup.xls
    34 KB · Đọc: 48
  • vlookup.xlsm
    13.3 KB · Đọc: 56
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!
 
_

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

  • _.xlsx
    9 KB · Đọc: 20
ChanhTQ@ đã viết:
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!
Nhấp chuột vào đây để mở rộng...
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
Nhấp chuột vào đây để mở rộng...

Đâ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

ChanhTQ@ đã viết:
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!
Nhấp chuột vào đây để mở rộng...
Không hiểu sao nó lại ra NOTHING ạh
 

File đính kèm

  • Nothing.xlsm
    16.4 KB · Đọc: 25
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)
. . . . .
 
ChanhTQ@ đã viết:
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!
Nhấp chuột vào đây để mở rộng...
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
ChanhTQ@ đã viết:
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!
Nhấp chuột vào đây để mở rộng...
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
Cá ngừ F1 đã viết:
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
Nhấp chuột vào đây để mở rộng...
Đư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!
 
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
Nhấp chuột vào đây để mở rộng...

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

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

  • thuc hanh_3.rar
    45.7 KB · Đọc: 47
ultimatum86 đã viết:
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.
Nhấp chuột vào đây để mở rộng...

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

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

K
Nhờ mọi người hỗ trợ giúp mình về tìm kiếm trong VBA. Mình sẽ gửi chút chi phí cafe cám ơn nhiều ạ
    • Cười
Trả lời
17
Đọc
240
SA_DQ
SA_DQ
ptm0412
Hàm XLOOKUP: Có thể bạn chưa biết hết tính năng và ứng dụng
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
2
Đọc
8K
maikhoamt
maikhoamt
phammaihuong90
Hàm tìm ngày gần nhất đạt được số lượng mục tiêu
Trả lời
9
Đọc
228
Phan Thế Hiệp
Phan Thế Hiệp
1
Xin hỗ trợ về tính tổng các dòng loại trừ dòng ẩn nhưng các dòng không liền nhau
Trả lời
5
Đọc
128
VetMini
V
L
Các lấy công thức
Trả lời
5
Đọc
90
VetMini
V
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