Code VBA tìm kiếm từ sheet khác (1 người xem)

[GTK-PM]

Gửi anh chị, như tiêu đề em muốn xin 1 code VBA dò tìm như hàm vlookup
Cám ơn anh chị

 

[SA_DQ]

1./ Đây là fần lí thuyết về fương thức FIND()
http://www.giaiphapexcel.com/forum/showthread.php?15116-Tổng-hợp-về-phương-thức-tìm-kiếm-FIND-(Find-Method)

2./ Một số Code minh họa:

a./

Option Explicit
Sub TimDS()
 Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range
 Dim Tmr#, MyAdd$, Rws&
 
 Sheets("Censored").Select:                         Tmr = Timer()
 Set Sh = ThisWorkbook.Worksheets("To be checked")
 Set Rng = Sh.UsedRange
 Columns("C:Z").ClearContents
 Rws = [A7].CurrentRegion.Rows.Count
 For Each Cls In [A1].Resize(Rws)
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlPart)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Do
            Cells(Cls.Row, "IU").End(xlToLeft).Offset(, 2).Value = sRng.Address
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
 Next Cls
 Cells(Rws, "c").Value = Timer() - Tmr
End Sub

b./

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [F1]) Is Nothing Then
    Dim Sh As Worksheet, Rng As Range, sRng As Range
    Dim MyAdd As String, Rws As Long
11 'Hien Thi Toàn Bo Các Dòng:'
    Rows("4:22").Hidden = False
12 'Xóa Du Lieu Làn Truóc:'
    [C4].Resize(20, 2).ClearContents
13 'Tìm & Chép Du Lieu Cua Nguòi Da Chon:'
    Set Sh = ThisWorkbook.Worksheets("T10")
    Set Rng = Sh.Range(Sh.[b5], Sh.[B6].End(xlDown))
    Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        Set Rng = Sh.Range(sRng.Offset(, 1), Sh.Cells(sRng.Row, "iV").End(xlToLeft).Offset(, -1))
        For Each sRng In Rng
            If sRng.Value > 0 Then
                With [c24].End(xlUp).Offset(1)
                    .Value = Sh.Cells(4, sRng.Column).Value
                    .Offset(, 1).Value = sRng.Value
                End With
            End If
        Next sRng
    End If
14 'An Các Dòng Tróng Fía Duói:'
    Rws = [c24].End(xlUp).Row + 2
    Rows(Rws & ":22").Hidden = True
    [C3].Resize(, 4).Interior.ColorIndex = 34 + (Rws Mod 9)
    Set Sh = Nothing:               Rws = 0
21 'Xóa Du Lieu Làn Truóc:'
    [C28].Resize(16, 7).ClearContents
22 'Tìm & Chép Du Lieu Cua Noi Bán:'
    Set Rng = Range([h50], [h50].End(xlDown))
    Set sRng = Rng.Find(Trim$([J1].Value), , xlFormulas, xlPart)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Do
            Rws = Rws + 1
            With [c44].End(xlUp).Offset(1)
                .Resize(, 4).Value = sRng.Offset(, -5).Resize(, 4).Value
            End With
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
        [C27].Resize(, 4).Interior.ColorIndex = 34 + (Rws Mod 9)
    End If
 End If
End Sub

. . . . (Tạm là vậy, bạn tự tìm thêm)

 

[GTK-PM]

HYen có thể giải thích phần chữ màu đỏ, và màu cam bạn đã bôi màu đc ko

 

[VetMini]

HYen có thể giải thích phần chữ màu đỏ, và màu cam bạn đã bôi màu đc ko

Khi code được bỏ vào khung dùng kiểu PHP:

Muốn chữ màu đỏ thì đóng nó trong nháy kép: "chữ màu đỏ"

muốn màu cam thì cho nó đi sau dấu thăng: # Màu Cam

hai dấu gạch chéo cũng được: // cũng Màu Cam