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

[tr hoan]

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?

 

[nghiaphuc]

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.

 

[billquan]

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.

 

[Cá ngừ F1]

thêm ký tự trước mã

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

 

[ChanhTQ@]

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á ngừ F1]

_

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

 

[Cá ngừ F1]

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

 

[SA_DQ]

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

 

[Cá ngừ F1]

Nothing

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

 

[SA_DQ]

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

 

[Cá ngừ F1]

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ì?

 

[Cá ngừ F1]

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

 

[Ba 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

Đư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!

 

[robberman]

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

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

 

[TrungChinhs]

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

 

[Ba Tê]

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

Coi chừng bị nhầm à anh TrungChinh, người hỏi là 170.000 dòng lớn hơn 65.536 đó.

 

[TrungChinhs]

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

 

[ultimatum86]

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.

 

[Let'GâuGâu]

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)

 

[ultimatum86]

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