Dò tìm chỉ cho kết quả khi nhập từng ô, dán nhiều dữ liệu cùng lúc thì bị lỗi

[Lê Hồng Minh83]

Chào các thành viên diễn đàn
Trong file, cột B là cột dò, cột G để trả kết quả.
Code hiện hành chỉ cho kết quả khi nhập hoặc paste từng ô dữ liệu ở cột B, nếu paste nhiều dữ liệu vào thì code bị lỗi
Mong các thành viên khác giúp đỡ để mình có thể dán nhiều ô dữ liệu cùng lúc ở cột B
Cảm ơn!

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
    If Target <> Empty Then
        Target.Offset(, 5) = "=LOOKUP(2,1/(Sheet2!R3C2:R10C2=RC[-5]),Sheet2!R3C3:R10C3)"
        Target.Offset(, 5).Value = Target.Offset(, 5).Value
    Else
        Target.Offset(, 5) = Empty
    End If
End If
End Sub

 

[phulien1902]

Chào các thành viên diễn đàn
Trong file, cột B là cột dò, cột G để trả kết quả.
Code hiện hành chỉ cho kết quả khi nhập hoặc paste từng ô dữ liệu ở cột B, nếu paste nhiều dữ liệu vào thì code bị lỗi
Mong các thành viên khác giúp đỡ để mình có thể dán nhiều ô dữ liệu cùng lúc ở cột B
Cảm ơn!

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
    If Target <> Empty Then
        Target.Offset(, 5) = "=LOOKUP(2,1/(Sheet2!R3C2:R10C2=RC[-5]),Sheet2!R3C3:R10C3)"
        Target.Offset(, 5).Value = Target.Offset(, 5).Value
    Else
        Target.Offset(, 5) = Empty
    End If
End If
End Sub

Bạn thử:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim LR As Long
    LR = Sheets(1).Range("B65000").End(xlUp).Row
    If Not Intersect(Target, Range("B3:B" & LR)) Is Nothing Then
        Application.EnableEvents = False
        Range("G3:G" & LR).Value = "=LOOKUP(2,1/(Sheet2!R3C2:R10C2=RC[-5]),Sheet2!R3C3:R10C3)"
        Application.EnableEvents = True
    End If
End Sub

+ Cách khác:

Sub abc()
    Dim LR As Long
    LR = Range("B3").End(xlDown).Row
    Range("G3:G" & LR).Formula = "=LOOKUP(2,1/(Sheet2!R3C2:R10C2=RC[-5]),Sheet2!R3C3:R10C3)"
End Sub

 

[ndu96081631]

Chào các thành viên diễn đàn
Trong file, cột B là cột dò, cột G để trả kết quả.
Code hiện hành chỉ cho kết quả khi nhập hoặc paste từng ô dữ liệu ở cột B, nếu paste nhiều dữ liệu vào thì code bị lỗi
Mong các thành viên khác giúp đỡ để mình có thể dán nhiều ô dữ liệu cùng lúc ở cột B
Cảm ơn!

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
    If Target <> Empty Then
        Target.Offset(, 5) = "=LOOKUP(2,1/(Sheet2!R3C2:R10C2=RC[-5]),Sheet2!R3C3:R10C3)"
        Target.Offset(, 5).Value = Target.Offset(, 5).Value
    Else
        Target.Offset(, 5) = Empty
    End If
End If
End Sub

Muốn sự kiện Change có tác dụng trên nhiều cells thì phải dùng vòng lập

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rngFind As Range, cel As Range
  If Target.Column = 2 Then
    For Each cel In Target
      If cel.Value <> Empty Then
        Set rngFind = Sheet2.Range("B3:C1000").Find(cel.Value, , xlValues, xlWhole, , , False)
        If Not rngFind Is Nothing Then cel.Offset(, 5) = rngFind.Offset(, 1)
      Else
        cel.Offset(, 5) = Empty
      End If
    Next
  End If
End Sub

Đã code VBA mà còn công thức gì trong đó nữa bạn? Nhân tiên sửa luôn, dùng Find Method, bỏ công thức

 

[Lê Hồng Minh83]

Muốn sự kiện Change có tác dụng trên nhiều cells thì phải dùng vòng lập

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rngFind As Range, cel As Range
  If Target.Column = 2 Then
    For Each cel In Target
      If cel.Value <> Empty Then
        Set rngFind = Sheet2.Range("B3:C1000").Find(cel.Value, , xlValues, xlWhole, , , False)
        If Not rngFind Is Nothing Then cel.Offset(, 5) = rngFind.Offset(, 1)
      Else
        cel.Offset(, 5) = Empty
      End If
    Next
  End If
End Sub

Đã code VBA mà còn công thức gì trong đó nữa bạn? Nhân tiên sửa luôn, dùng Find Method, bỏ công thức

Cảm ơn Thầy, em đang mày mò record marco thôi, chế cái này một ít, cái kia một ít

 

[ndu96081631]

Cảm ơn Thầy, em đang mày mò record marco thôi, chế cái này một ít, cái kia một ít

Tôi nhắc vụ công thức trong VBA là vì: Nếu dùng công thức trong code thì chẳng khác nào bạn gõ bằng tay công thức đó trên bảng tính. Cho dù sau đó bạn có động tác copy/paste values đi chăng nữa thì cũng làm file chậm đi. Dữ liệu ít có thể bạn không thấy gì nhưng nếu dữ liệu nhiều, chắc chắn mỗi lần sự kiện Change được kích hoạt, bạn sẽ thấy bảng tính bị "đơ" trong giây lát
Nên tìm hiểu những phương thức khác thay thế cho công thức khi viết code VBA

 

[Lê Hồng Minh83]

Tôi nhắc vụ công thức trong VBA là vì: Nếu dùng công thức trong code thì chẳng khác nào bạn gõ bằng tay công thức đó trên bảng tính. Cho dù sau đó bạn có động tác copy/paste values đi chăng nữa thì cũng làm file chậm đi. Dữ liệu ít có thể bạn không thấy gì nhưng nếu dữ liệu nhiều, chắc chắn mỗi lần sự kiện Change được kích hoạt, bạn sẽ thấy bảng tính bị "đơ" trong giây lát
Nên tìm hiểu những phương thức khác thay thế cho công thức khi viết code VBA

Dạ, em đang tìm hiểu về VBA, cố gắng áp dụng những cái học được, còn tối ưu vấn đề thì chắc còn rất lâu nữa

 

[be_09]

Chào các thành viên diễn đàn
Trong file, cột B là cột dò, cột G để trả kết quả.
..................................................

Thêm cách khác:
Nếu dữ liệu nhiều thì tôi khuyên không nên dùng Worksheet_Change (sẽ bực mình khi thay đổi cái gì đó phải ngồi chờ).
Vì vậy, khi nào cần tra thì mình mới nhấn nút để tra.

Sub Tra_DanhSach()
    On Error Resume Next
    Dim CotDo, BangTra, Tim As Variant
    Dim TimDong, TimCot As Long
  
    BangTra = Sheet2.Range("B3:C1000") 'Data
  
    Sheet1.Range("G3:G1000").ClearContents
    CotDo = Sheet1.Range("B3:B1000") 'Tìm
    TimDong = Sheet1.Range("G3").Row 'Tìm
    TimCot = Sheet1.Range("G3").Column 'Tìm
    For Each Tim In CotDo
        'Tìm
        Sheet1.Cells(TimDong, TimCot) = Application.WorksheetFunction. _
        VLookup(Tim, BangTra, 2, False)
        TimDong = TimDong + 1
    Next Tim
    MsgBox "TÌM XONG RÒI", vbMsgBoxRtlReading"
End Sub

 

[Minh Ngọc LH]

Thêm cách khác:
Nếu dữ liệu nhiều thì tôi khuyên không nên dùng Worksheet_Change (sẽ bực mình khi thay đổi cái gì đó phải ngồi chờ).
Vì vậy, khi nào cần tra thì mình mới nhấn nút để tra.

Sub Tra_DanhSach()
    On Error Resume Next
    Dim CotDo, BangTra, Tim As Variant
    Dim TimDong, TimCot As Long
 
    BangTra = Sheet2.Range("B3:C1000") 'Data
 
    Sheet1.Range("G3:G1000").ClearContents
    CotDo = Sheet1.Range("B3:B1000") 'Tìm
    TimDong = Sheet1.Range("G3").Row 'Tìm
    TimCot = Sheet1.Range("G3").Column 'Tìm
    For Each Tim In CotDo
        'Tìm
        Sheet1.Cells(TimDong, TimCot) = Application.WorksheetFunction. _
        VLookup(Tim, BangTra, 2, False)
        TimDong = TimDong + 1
    Next Tim
    MsgBox "TÌM XONG RÒI", vbMsgBoxRtlReading"
End Sub

Hay thật. 1 vấn đề mà có vô vàn cách giải quyết