Cần giúp tự động rút gọn danh sách khi gõ chữ "Lê Thị" (1 người xem)

hung2412 · 29/10/15

Xin chào các Anh chị và các bạn GPE!
Nhờ các Anh chị và các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Tôi có một File Excel có dữ liệu như sau:

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ì danh sách tự động rút gọn chỉ còn những ô chứa chữ Lê và tô màu xanh như vầy (Những dòng không chứa chữ Lê thì tự động ẩn đi):

Vẫn tại ô B3 gõ tiếp chữ Thị (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ì danh sách tự động rút gọn tiếp chỉ còn những ô chứa chữ Lê Thị và tô màu xanh như vầy (Những dòng không chứa chữ Lê Thị thì tự động ẩn đi):

=> Có cách nào làm được những công đoạn như trên hay không?
Mong các Anh chị và các bạn GPE chỉ giáo!
Trân trọng cảm ơn!
P/s: Có 01 File đính kèm.

giangleloi · 29/10/15

hung2412 đã viết:
Xin chào các Anh chị và các bạn GPE!
Nhờ các Anh chị và các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Tôi có một File Excel có dữ liệu như sau:

=> Có cách nào làm được những công đoạn như trên hay không?
Mong các Anh chị và các bạn GPE chỉ giáo!
Trân trọng cảm ơn!
P/s: Có 01 File đính kèm.

Bài dạng này tôi cũng làm nhiều lần rồi. Nhưng vấn đề là sử dụng code nha bạn.

hung2412 · 29/10/15

giangleloi đã viết:
Bài dạng này tôi cũng làm nhiều lần rồi. Nhưng vấn đề là sử dụng code nha bạn.

Cụ thể như thế nào bạn?

jack nt · 29/10/15

hung2412 đã viết:
Xin chào các Anh chị và các bạn GPE!
Nhờ các Anh chị và các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:

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ì danh sách tự động rút gọn chỉ còn những ô chứa chữ Lê và tô màu xanh như vầy (Những dòng không chứa chữ Lê thì tự động ẩn đi):

Vẫn tại ô B3 gõ tiếp chữ Thị (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ì danh sách tự động rút gọn tiếp chỉ còn những ô chứa chữ Lê Thị và tô màu xanh như vầy (Những dòng không chứa chữ Lê Thị thì tự động ẩn đi):

=> Có cách nào làm được những công đoạn như trên hay không?
Mong các Anh chị và các bạn GPE chỉ giáo!
Trân trọng cảm ơn!
P/s: Có 01 File đính kèm.

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Integer
    If Target.Address = "$B$3" Then
        For i = 4 To 35
            Rows(i).EntireRow.Hidden = Not UCase(Cells(i, 2)) Like UCase([B3]) & "*"
        Next
    End If
End Sub

thay For ... Next thành Do ... Loop nếu số dòng không xác đinh.

doveandrose · 29/10/15

giangleloi đã viết:
Bài dạng này tôi cũng làm nhiều lần rồi. Nhưng vấn đề là sử dụng code nha bạn.

ủa bài này sử dụng code làm sao vậy anh ? anh chỉ em làm với . cảm ơn anh }}}}}

giangleloi · 29/10/15

doveandrose đã viết:
ủa bài này sử dụng code làm sao vậy anh ? anh chỉ em làm với . cảm ơn anh

Lại chơi chiêu nhau nữa rồi. Viết xong rồi nhưng cũng giống #4 nên không post. Chàng gọi thì "thiếp" trả lời vậy:

Mã:

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

P/s: Có thể thay bằng hàm Instr.

giangleloi · 29/10/15

hpkhuong đã viết:
Vẫn For Next mà xác định dòng cuối thì vẫn ok mà. Cần gì Do Loop nhỉ? Vả lại tác giả muốn gõ tiếp tục thì nó dò luôn
Chứ Worksheet_Change ở trên vẫn phải enter....

-------------------------
P/s: cơ mà bài này dùng Advanced Filter được hok ta? ai thử xem phát...

Chàng có ý tưởng thì chàng phải phát huy đi chứ. :drinks:

n0thing1988 · 29/10/15

Cho em hỏi làm như vậy với datavalidition. Hoặc cho em xin link bài hướng dẫn cũng được ạ

jack nt · 29/10/15

hpkhuong đã viết:
Vẫn For Next mà xác định dòng cuối thì vẫn ok mà. Cần gì Do Loop nhỉ? Vả lại tác giả muốn gõ tiếp tục thì nó dò luôn
Chứ Worksheet_Change ở trên vẫn phải enter....

muốn không phải Enter thì gắn một cái TextBox vào ô B3 rồi dùng sự kiện Text_Change.

giangleloi · 29/10/15

n0thing1988 đã viết:
Cho em hỏi làm như vậy với datavalidition. Hoặc cho em xin link bài hướng dẫn cũng được ạ

Cứ thử tạo 1 cái data validation tại ô B3 thì sẽ rõ.

hung2412 · 29/10/15

jack nt đã viết:
muốn không phải Enter thì gắn một cái TextBox vào ô B3 rồi dùng sự kiện Text_Change.

Mong bạn có thể nói cụ thể hơn được không?

hung2412 · 29/10/15

hpkhuong đã viết:

Insert 1 cái TextBox (thuộc ActiveX control) ấy.

Sau đó xài code này cho nó

Mã:

Option Explicit
Private Sub TextBox1_Change()
Application.ScreenUpdating = False
If TextBox1.Text <> Empty Then
        Range("A3:B1000").AdvancedFilter 1, [D1:D2]
        [D1].Value = [B3].Value
        [D2].Value = "=""*""&B3&""*"""
        Range("A3:B1000").AdvancedFilter 1, [D1:D2]
        [D1:D2].Value = Empty
    Else
        Range("A3:B1000").AdvancedFilter 1, [D1:D2]
    End If
Application.ScreenUpdating = True
End Sub

Code này hay đấy. Nhưng chưa được tô màu như vầy:

=> Thì phải làm sao nhỉ?

doatmenhhon · 29/10/15

Góp vui bằng file này xem sao (Mở bằng excel 2010 thì chạy tốt)

thaitdtt · 29/10/15

doveandrose · 29/10/15

xin lỗi spam để xem được bài viết cuối , hiện tại hổng thấy nó đâu hết

doveandrose · 29/10/15

hpkhuong đã viết:
Người ta đã biết sử dụng code. Tất nhiên cái đơn giản này họ đã biết rồi. Chí yếu là làm cho thao tác nó nhanh hơn...
Hok lẻ bạn nghỉ code nó chậm hơn là bạn phải đi AutoFilter, rồi lê chuột đi vào cái nơi mình cần gõ và gõ gõ....rồi Ok thì excel nó mới lọc ah??? Bạn nghĩ sao mà nói chỉ là ý tưởng của chủ topic để cho mọi người phát huy???

thì khả năng phát huy của thaitdtt là bấm vào nút Filter rồi ghi Lê Thi* . Đó cũng là cách ông cha ta truyền lại
Bạn nào mạnh mẽ hơn thì có thể phát huy sở trường khác
sao bạn khó khăn thế nhờ ?

giangleloi · 29/10/15

hung2412 đã viết:
Code này hay đấy. Nhưng chưa được tô màu như vầy:

=> Thì phải làm sao nhỉ?

Bạn tùy biến theo cái bạn muốn, chỉ làm tiếp phần trên và tô màu cho bạn:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Address = "$B$3" Then
Dim Dk, Arr(), i
  Arr = Range([B4], [B65536].End(3)).Value
  Dk = [B3].Value
    If Dk = Empty Then Cells.EntireRow.Hidden = False
     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(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

P/s: Muốn tô chính xác khi chỉ cần gõ tên lót thì code vẫn cần chỉnh lại.

comet_1701 · 29/10/15

hung2412 đã viết:
Xin chào các Anh chị và các bạn GPE!
Nhờ các Anh chị và các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Tôi có một File Excel có dữ liệu như sau:

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ì danh sách tự động rút gọn chỉ còn những ô chứa chữ Lê và tô màu xanh như vầy (Những dòng không chứa chữ Lê thì tự động ẩn đi):

Vẫn tại ô B3 gõ tiếp chữ Thị (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ì danh sách tự động rút gọn tiếp chỉ còn những ô chứa chữ Lê Thị và tô màu xanh như vầy (Những dòng không chứa chữ Lê Thị thì tự động ẩn đi):

=> Có cách nào làm được những công đoạn như trên hay không?
Mong các Anh chị và các bạn GPE chỉ giáo!
Trân trọng cảm ơn!
P/s: Có 01 File đính kèm.

Mã:

With Cells(i + 3, 2)
        .Characters(InStr(Cells(i + 3, 2), Dk), Len(Dk)).Font.Color = vbRed
    End With

ơ cái đoạn tô màu anh Hùng có thể thêm đoạn này,

giangleloi · 29/10/15

hpkhuong đã viết:
Code chưa bẫy lỗi nếu...chỉ dòng đầu tiên tìm được (dòng 4 ấy), muốn tìm nữa thì lỗi............kaka...

Không phải chưa bẫy mà đói quá, tranh thủ post bài đi ăn tô mì bò (mà bạn hiền cũng không tha)

Mã:

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(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

giangleloi · 29/10/15

hpkhuong đã viết:
Code vẫn chưa tô màu theo ký tự cần gõ...bạn hiền cần thêm hàm InStr nữa....kakaka

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.

Mã:

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

hung2412 · 30/10/15

giangleloi đã viết:

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.

Mã:

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 · 30/10/15

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 · 30/10/15

hpkhuong đã viết:
Đã 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à...

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 · 30/10/15

doveandrose đã viết:
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 · 30/10/15

hpkhuong đã viết:
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 · 30/10/15

hung2412 đã viết:
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 · 30/10/15

doveandrose đã viết:
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.

hpkhuong đã viết:
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 · 30/10/15

giangleloi đã viết:
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 · 30/10/15

hpkhuong đã viết:
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 · 30/10/15

hpkhuong đã viết:
Í........................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 · 30/10/15

hpkhuong đã viết:

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

Mã:

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.

Cần giúp tự động rút gọn danh sách khi gõ chữ "Lê Thị" (1 người xem)

Người dùng đang xem chủ đề này

Thành viên tích cực

File đính kèm

Thành viên gắn bó

Thành viên tích cực

Thành viên thường trực

hello

Thành viên gắn bó

Thành viên gắn bó

Mù VBA

Thành viên thường trực

Thành viên gắn bó

Thành viên tích cực

Thành viên tích cực

Thành viên tiêu biểu

File đính kèm

Thành viên mới

hello

hello

Thành viên gắn bó

Thành viên tiêu biểu

Thành viên gắn bó

Thành viên gắn bó

Thành viên tích cực

hello

Thành viên tích cực

Thành viên gắn bó

Thành viên gắn bó

hello

Thành viên gắn bó

File đính kèm

Thành viên tiêu biểu

Thành viên gắn bó

Thành viên gắn bó

Thành viên gắn bó

Thời gian đếm ngược.