Cần giúp tự động rút gọn danh sách khi gõ chữ "Lê Thị"

[hung2412]

Biết thế nào cũng có người hỏi như vậy mà. Cho nên mới có chú thích ở trên là chủ topic cần mới chỉnh thêm. Mà hình như bạn "hành" vợ chưa đủ hả ta.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Address = "$B$3" Then
Cells.EntireRow.Hidden = False
Dim Dk, Arr(), i
  Arr = Range([B4], [B65536].End(3)).Value
  Dk = [B3].Value
    If Dk = Empty Then [B4:B10000].Font.Color = vbBlack
     For i = UBound(Arr) To LBound(Arr) Step -1
        If Not UCase(Arr(i, 1)) Like "*" & UCase(Dk) & "*" Then
            Rows(i + 3).EntireRow.Hidden = True
           Else
            Range("B" & i + 3).Characters(InStr(1, Range("B" & i + 3), Dk, 1), Len(Dk)).Font.Color = vbRed
        End If
     Next i
    If Dk = Empty Then [B4:B10000].Font.Color = vbBlack
End If
Application.ScreenUpdating = True
End Sub

Code của bạn là phải Enter rồi nó mới tô màu.
Tôi muốn là Tại ô B3 gõ vào chữ Lê (nhưng chưa gõ phím Enter để kết thúc => nghĩa là con chuột vẫn nhấp nháy tại ô B3) thì những ô chứa chữ Lê tô màu xanh như vầy bạn ah:

 

[doveandrose]

phim chưa hết nữa à , không biết hôm nay Giang cô đơn có lên diễn đàn không nữa

 

[hung2412]

Đã muốn nó gõ được thì có bạn bên trên gợi ý là dùng sự kiện change của textbox, có ban gợi ý (#11), và tới #15 tôi đã làm thử ví dụ cho bạn theo code Ad tôi đã làm.
Nên có lẻ bạn hiểu và tự biến chuyển code mảng của bạn giangleloi để ráp vô cái sự kiện change textbox1 chứ... Cái này tôi nghĩ bạn làm được mà...

Option Explicit
Private Sub TextBox1_Change()
Application.ScreenUpdating = False
Cells.EntireRow.Hidden = False
Dim Dk, Arr(), I
  Arr = Range([B4], [B65536].End(3)).Value
If TextBox1.Text <> Empty Then
  Dk = [B3].Value
    If Dk = Empty Then [B4:B10000].Font.Color = vbBlack
     For I = UBound(Arr) To LBound(Arr) Step -1
        If Not UCase(Arr(I, 1)) Like "*" & UCase(Dk) & "*" Then
            Rows(I + 3).EntireRow.Hidden = True
           Else
            Range("B" & I + 3).Characters(InStr(UCase(Range("B" & I + 3)), UCase(Dk)), Len(Dk)).Font.Color = vbGreen
        End If
     Next I
Else
    Cells.EntireRow.Hidden = False
    [B4:B10000].Font.Color = vbBlack
End If
Application.ScreenUpdating = True
End Sub

Code bị Debug rồi bạn.

 

[giangleloi]

phim chưa hết nữa à , không biết hôm nay Giang cô đơn có lên diễn đàn không nữa

"Hắt xì" sáng giờ. Thì ra là có "chàng" nhắc tới, lên hay hông cũng đâu quan trọng, mà lên được thì càng tốt

 

[giangleloi]

Debug hay không là do người chạy code chứ sao lại la làng lên thế nhỉ? Ở trên là sub sự kiện cho cái TextBox1. Thế bạn đã vẽ cái TextBox1 chưa mà chạy???

Vẽ rồi và chạy rồi cũng bị như #32, bạn hiền post file lên đây để "phá" nào???

 

[doveandrose]

Code bị Debug rồi bạn.

bạn đi giao lưu với các vị anh hùng mạnh mẽ như hpKhuong , GiangLeLoi mà sao bạn không hỏi tới bến để phục vụ cho công việc
thí dụ như
Anh GiangLeLoi ơi sao em gõ 1 hồi nó ra lỗi như này

rồi anh Giang cô đơn ơi , tên trong danh sách toàn tiếng Việt , phải gõ cả Lê Thị nó mới tìm được , em thấy mệt
Giờ em muốn gõ Le Thi nó vẫn tìm ra các tên Lê Thị , anh giúp em với

ấy những cái như thế sao bạn không hỏi , bạn hỏi mấy cái đơn giản quá họ không thích đâu ....

 

[giangleloi]

gõ 1 hồi nó ra lỗi như này

Nói chung là ai bỏ vô sự kiện textbox_change thì người đó sửa đi chớ, liên quan gì tới tui đâu.

Sao tôi chạy trên máy tôi bình thương mà nhỉ? FIle đây này... (vui lòng xem file #39)

Máy chàng xịn quá, bì theo hông kịp:

 

[doatmenhhon]

Máy chàng xịn quá, bì theo hông kịp:

Máy mình loại chậm, excel thì 2003 vẫn chạy được mà. Nhân tiện chúc Giang đại hiệp sắp lên sao vàng đứng im nhá

 

[giangleloi]

Gì kỳ vậy chời, code là của chàng Giangleloi mà, tôi có chỉnh gì đâu nà...chỉ gán vào cái sự kiện texbox_change thôi mà...sao lại lỗi "hidden" cơ chứ....

Nói chung là hông biết, chỉ biết bỏ cái dòng này Cells.EntireRow.Hidden = False ở đoạn đầu đi thì sẽ ngon lành.

 

[giangleloi]

Í........................Vậy cho hỏi dòng đó là của anh chàng nao vậy ta??? nhớ hok lầm thì là dòng bẫy lỗi của anh chàng nào đó đó...

Xin lỗi là dòng đó, code đó xài cho Worksheet_Change. Chàng mang đi đổi qua cái khác rồi thêm vào ở bên dưới nữa, hơi bị kì nha.

 

[giangleloi]

Vậy bẩy theo kiểu này đi. Thay sự kiện trên bằng cái này xem.Dong mảng dư ra 1 dòng cũng có chết thằng TÂY nào đâu nàk...kaka

Option Explicit
Private Sub TextBox1_Change()
Application.ScreenUpdating = False
'Cells.EntireRow.Hidden = False
Dim Dk, Arr(), I, lr
lr = [B65536].End(3).Row
    Arr = Range("B4:B" & lr + 1).Value
If TextBox1.Text <> Empty Then
  Dk = [B3].Value
    If Dk = Empty Then [B4:B10000].Font.Color = vbBlack
     For I = UBound(Arr) To LBound(Arr) Step -1
        If Not TV((Arr(I, 1))) Like "*" & TV(Dk) & "*" Then
            Rows(I + 3).EntireRow.Hidden = True
           Else
            Range("B" & I + 3).Characters(InStr(TV(Range("B" & I + 3)), TV(Dk)), Len(Dk)).Font.Color = vbGreen
        End If
     Next I
Else
    Cells.EntireRow.Hidden = False
    [B4:B10000].Font.Color = vbBlack
End If
Application.ScreenUpdating = True
End Sub

Thêm vô làm gì nữa vậy trùi, cái trên là được rồi, chỉ có thể là siêu nhân hpkhuong.