Giúp e làm tìm kiếm trên excel với ạ (1 người xem)

[thunga25]

Em đang muốn làm tìm kiếm bằng lập trình vba trong excel. mà e tự mày mò chứ ko được học nên muốn nhờ anh chị làm giúp em với ạ.
File em đính kèm

 

[Anh DW]

Tim Kiem

Mình làm mẫu cho bạn,bạn ko cần dùng find dau.

 

[thunga25]

cảm ơn bạn Anh DW nhiều, nhưng bạn hướng dẫn mình làm với chứ mình không biết làm sao ra kết quả được bạn Anh DW nak

 

[thunga25]

mình biết làm rồi bạn nak

 

[ChanhTQ@]

Còn macro TimKiem của bạn như thế này:

Option Explicit
Sub TimKiem()
 Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range
 Set Sh = ThisWorkbook.Worksheets("DanhSachNV")
 [A12].CurrentRegion.Offset(1).ClearContents        '<=| Xóa Du Lieu Cu'
 For Each Cls In Range("A5:G5")
    If Cls.Value <> "" Then
        Set sRng = Sh.Cells(5, Cls.Column)
        Set Rng = Sh.Range(sRng, sRng.End(xlDown))  '<=| Xác Dinh Vùng De Tìm'
        Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
        If Not sRng Is Nothing Then                 '<=| Ne1u Tìm Tháy Thì Chép Bàng Lenh Duói'
            Sh.Cells(sRng.Row, "A").Resize(, 7).Copy Destination:=[A999].End(xlUp).Offset(1)
            Exit For
        End If
    End If
Next Cls
End Sub

 

[phucbugis]

Mình làm mẫu cho bạn,bạn ko cần dùng find dau.

dùng Find khi tìm STT cũng được, nhưng còn các điều kiện khác có lẽ phải cần đến Advanced Filter ---> có thể gộp chung dùng AdvFilter, nhưng điều kiện bạn cài --> người dùng phải nhập ký tự đại diện * (vào đầu và đuôi của 1 chuỗi, tương ứng với ô tìm kiếm) thì mới tìm được tương đối --> làm chậm quá trình tìm kiếm.
'----------------
mình nghĩ bài toán trên ko đơn giản như vậy, có thể xảy ra các trường hợp sau:
- #1: tìm STT ||--> tìm chính xác
- #2: tìm Mã nhân viên ||--> có thể tìm tương đối hoặc chính xác
- #3: các ô Họ tên, Ngày sinh ... ||--> tìm tương đối

 

[thunga25]

còn mình muốn tìm kiếm khi gõ vào textbox không cần bấm nút tìm kiếm thì phải làm sao

em muốn làm sự kiện textchange để tìm kiếm không cần bấm nút tìm kiếm thì phải làm sao ạ? anh chị giúp e với. có file đính kèm anh chị xem e với

 

[dhn46]

Bạn chắc cũng đã biết ít nhiều về VBA, vậy bạn làm như sau:
Chèn 1 module và copy đoạn Code dưới đây vào\

Sub Timkiem()
    Dim Arr, Res, i As Long, j As Long
    Arr = Sheet2.Range("A5:G" & Sheet2.Range("A65536").End(3).Row)
    ReDim Res(1 To UBound(Arr, 1), 1 To 7)
    For i = 1 To UBound(Arr, 1)
        If Arr(i, 1) Like Sheet1.TextBox1 & "*" Then
            If UCase(Arr(i, 2)) Like UCase(Sheet1.TextBox2) & "*" Then
                If UCase(Arr(i, 3)) Like UCase(Sheet1.TextBox3) & "*" Then
                    If UCase(Arr(i, 4)) Like UCase(Sheet1.TextBox4) & "*" Then
                        If UCase(Arr(i, 5)) Like UCase(Sheet1.TextBox5) & "*" Then
                            If UCase(Arr(i, 6)) Like UCase(Sheet1.TextBox6) & "*" Then
                                If UCase(Arr(i, 7)) Like UCase(Sheet1.TextBox7) & "*" Then
                                    k = k + 1
                                    For j = 1 To 7
                                        Res(k, j) = Arr(i, j)
                                    Next
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        End If
    Next
    Sheet1.Range("B11:H65536").ClearContents
    If k Then
        Sheet1.Range("B11").Resize(k, 7) = Res
    End If
End Sub

Gán cho sự kiện textbox change của 7 textbox của bạn, dạng như sau

Private Sub TextBox1_Change()
    Call Timkiem
End Sub

 

[phucbugis]

em muốn làm sự kiện textchange để tìm kiếm không cần bấm nút tìm kiếm thì phải làm sao ạ? anh chị giúp e với. có file đính kèm anh chị xem e với

trong trường hợp này ---> cần gì phải đặt trong Textbox
bạn tải file đính kèm về xem nhé, mình làm theo #6
- riêng ô B3, C3 sẽ tự động tìm ngay khi gõ xong + Enter
- các ô khác, đôi lúc cần tìm nhiều điều kiện kết hợp ---> phải dùng nút riêng

Private Sub Worksheet_Change(ByVal Target As Range)
Const cList = "B3, C3"
    If Not Intersect(Target, Range(cList)) Is Nothing Then
    If Target.Count > 1 Then Exit Sub 'bi. loi~ khi dung` Clear
        If Target <> "" Then Call GPE_loc
    End If
End Sub

Sub XoaSoLieu()
Range("B3:H3").ClearContents
End Sub

Sub GPE_loc()
Dim rng As Range
    
    Range("Tkiem_dk1").Offset(1).Resize(1).ClearContents 'ko the dat. o? Sub XoaSoLieu (co' truong hop xoa' bang` tay)
    
    If Trim(Range("Tkiem_stt")) <> "" Then
        Range("B8") = Trim(Range("Tkiem_stt"))              '|| tim` chinh' xac
        GoTo Next_
    ElseIf Trim([Tkiem_max]) <> "" Then 'o^ Tkiem_max dang co' Format Cells --> dang. Text
        [C8] = "*" & Trim([Tkiem_max]): GoTo Next_          '|| tim` tuong doi'
    End If
    '---------------
    For Each rng In Range("D3:H3")
    If Trim(rng.Value) <> "" Then
        If rng.Address = "$E$3" Then 'neu' la` Ngay sinh --> tim` chinh' xac
            Cells(8, rng.Column) = rng
        Else
            Cells(8, rng.Column) = "*" & Trim(rng.Value) & "*" '|| tim` tuong doi'
        End If
    End If
    Next
    '---------------
Next_:
    'clear Format Cells
    With Range("Tkiem_dk2").Offset(1).Resize(500) '<=> Range("B10:H500")
        .Borders.LineStyle = xlNone
        .Interior.ColorIndex = xlNone
    End With
    '----------- Advanced Filter
    Sheets("DanhsachNV").Range("A5:G5000").AdvancedFilter Action:=xlFilterCopy, _
                                                CriteriaRange:=Range("Tkiem_dk1"), _
                                                CopyToRange:=Range("Tkiem_dk2"), _
                                                Unique:=False
End Sub

 

[thunga25]

em làm giống anh nhưng không được

anh Phucbugic ơi em lam giống y anh mà chưa tìm được, anh xem cho em với