Đây là control gì? Excel có nó không?

Liên hệ QC
Vậy bạn có biết xài Addins không? Tôi lại có một đề nghị, không cần đặt cái combobox ở trong sheet, chỉ cần sau khi cài Addins vào thư mục Addins, rồi trong option check vào nó, thì lúc sử dụng bạn chỉ cần bấm phím tắt để chon hiện một form lên, cần tra từ nào thì tra rồi enter nó sẽ tìm đúng với mục đó. Bạn thấy như thế nào?

Như bài viết trên, tôi giới thiệu cho bạn cách làm mới:

Sau khi tải file về, giải nén và chép vào thư mục Addins như tôi đã hướng dẫn ở bài trước.

Bạn không cần mở file Addins này đâu, khi mở bất kỳ file nào thì nó cũng đã mở (ngầm) trước rồi vì thế chỉ cần thực hiện thao tác thôi.

Khi cần chọn cột cần tìm nào, bạn đặt con trỏ về ô đầu tiên của khối dữ liệu, ví dụ khối họ tên của bạn có họ tên đầu tiên ở ô B3 thì bạn đặt con trỏ tại ô B3 là ô hiện hành, sau đó bấm tổ hợp phím Ctrl+Shift+S để cho hiện Form.

Tại form có 1 textbox ghi lại địa chỉ ô hiện hành (bạn có thể thay đổi ô này nếu bạn muốn chọn cột khác), sau đó bạn chỉ bấm Enter hoặc nhấn vào nút Tạo List.

Lúc này trên form sẽ xuất hiện combobox và list danh sách đã được nạp vào, bạn chỉ việc gõ và Enter để tìm nhanh thôi.

Bất kỳ file nào bạn muốn tìm kiếm đều được, không chỉ riêng 2 file đâu, chỉ cần cài đặt Addins như đã hướng dẫn!

Chúc bạn vui khi sử dụng file này!
 

File đính kèm

Tôi làm được rồi cám ơn anh nhiều nhé, Anh Trọng Nghĩa ơi anh có nhiều chiêu hay làm tôi bất ngờ quá.

Khi tìm 1 tên phải bấm ctrl-shift-s, nếu tìm 10 tên phải bấm 10 lần, vậy mình có điều chỉnh cho form kéo dài thời gian xuất hiện đến khi tên cuối cùng tìm xong mới mất đi được không anh ?
 
Tôi làm được rồi cám ơn anh nhiều nhé, Anh Trọng Nghĩa ơi anh có nhiều chiêu hay làm tôi bất ngờ quá.

Khi tìm 1 tên phải bấm ctrl-shift-s, nếu tìm 10 tên phải bấm 10 lần, vậy mình có điều chỉnh cho form kéo dài thời gian xuất hiện đến khi tên cuối cùng tìm xong mới mất đi được không anh ?

Bạn đúng là được voi đòi 2 bà Trưng, giờ đòi tiếp bà Triệu mà!

Thôi, lỡ nuôi voi rồi, lên núi với bạn một chuyến luôn!

Tìm đã đi, không tìm nữa bấm nút thoát X cua form!
 

File đính kèm

Anh Trọng Nghĩa! Anh không chỉ giỏi excel mà còn là nghệ sỉ hài hước nữa, đọc mấy câu thoại tôi cười lăn ra luôn nè. Ai làm bạn với anh sẻ không bao giờ buồn. Một lần nữa cám ơn Anh Trọng Nghĩa nhé.
 
Toàn bộ code chỉ là vậy, thế nhưng bạn có hỏi tại sao gõ chữ Thanh mà không hiện lên các chữ liên quan có dấu, xin thưa với bạn là ở đây lọc xác định, nếu bạn muốn lọc tên có dấu thì bạn thêm dấu vào khi gõ!
Bạn Hoàng Trọng Nghĩa ơi để gõ chữ Thanh mà hiện lên các chữ liên quan có dấu như Thành, Thảnh... không biết cái code này có áp dụng được không? mình quên là đã tải nó ở đâu rồi chỉ biết textbox hay listbox thì dùng được

Function TV(ByVal Text As String) As String
Dim CharCode, ResText As String, i As Long, tmp As String
On Error Resume Next
tmp = Text
CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
ChrW(7849), ChrW(7851), ChrW(7853), ChrW(225), ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), _
ChrW(259), ChrW(226), ChrW(273), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
ChrW(233), ChrW(232), ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), _
ChrW(7881), ChrW(297), ChrW(7883), ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), _
ChrW(7899), ChrW(7901), ChrW(7903), ChrW(7905), ChrW(7907), ChrW(243), ChrW(242), ChrW(7887), _
ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), _
ChrW(7921), ChrW(250), ChrW(249), ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), _
ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))
ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy"
For i = 0 To UBound(CharCode)
tmp = Replace(tmp, CharCode(i), Mid(ResText, i + 1, 1))
tmp = Replace(tmp, UCase(CharCode(i)), UCase(Mid(ResText, i + 1, 1)))
Next
TV = tmp
End Function
 
Bạn Hoàng Trọng Nghĩa ơi để gõ chữ Thanh mà hiện lên các chữ liên quan có dấu như Thành, Thảnh... không biết cái code này có áp dụng được không? mình quên là đã tải nó ở đâu rồi chỉ biết textbox hay listbox thì dùng được

Function TV(ByVal Text As String) As String
Dim CharCode, ResText As String, i As Long, tmp As String
On Error Resume Next
tmp = Text
CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
ChrW(7849), ChrW(7851), ChrW(7853), ChrW(225), ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), _
ChrW(259), ChrW(226), ChrW(273), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
ChrW(233), ChrW(232), ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), _
ChrW(7881), ChrW(297), ChrW(7883), ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), _
ChrW(7899), ChrW(7901), ChrW(7903), ChrW(7905), ChrW(7907), ChrW(243), ChrW(242), ChrW(7887), _
ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), _
ChrW(7921), ChrW(250), ChrW(249), ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), _
ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))
ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy"
For i = 0 To UBound(CharCode)
tmp = Replace(tmp, CharCode(i), Mid(ResText, i + 1, 1))
tmp = Replace(tmp, UCase(CharCode(i)), UCase(Mid(ResText, i + 1, 1)))
Next
TV = tmp
End Function

Thật ra vấn đề này tôi đã nghiên cứu từ lâu, song chưa hoàn toàn chính xác nên tôi chưa gửi lên thôi. Nhưng với hàm này tôi không nghĩ là ứng dụng được với Lọc trong ComboBox được đâu.
 
tool nhập tên nhanh chính xác

Mến chào anh Trọng Nghĩa các anh chị và các bạn!
Trải qua thời gian dùng tool TimTenTool.rar của anh Trọng Nghĩa em thấy tool này rất hay, nay em thấy nó không chỉ dừng lại ở chức năng tìm tên nhanh mà nó còn có thể dùng nhập tên nhanh và chính xác nữa, nhưng em không biết lập trình nên em nhờ anh Trọng Nghĩa và các anh chị giúp đở ạ.

Cụ thể em muốn có một cái tool addin tương tự như TimTenTool của anh Trọng Nghĩa,tool gồm có một listbox,nút nạp list và nút nạp vùng nhập tên. Em lấy file toolnhapten để minh họa.

Tại sheet danh sách bấm phím tắc(phím nóng) cho tool hiện ra, trên tool có 1 nút nạp list và 1 nút nạp vùng nhập tênlistbox. Nhấp chọn ô B1 bấm nút nạp list,nguyên danh sách tên từ ô B2(Nguyễn Hải Chi) trở xuống được nạp vào tool. Tiếp đến tại sheet2 (hoặc một sheet bất kỳ của file excel khác đang mở), quét 1 khối ô bất kỳ cần nhập tên cụ thể là B3:B23, rồi bấm nút nạp vùng nhập tên , tool sẻ ghi nhận hiểu những ô này cần nhập tên từ list của tool, tại vùng cần nhập tên: ô B3 ta muốn nhập tên Phan Đình Phương chỉ cần gỏ P,H,A tool xổ list hiện dần cho đến khi ta thấy tên cần tìm Phan Đình Phương, ta chỉ cần dời chọn đến Phan Đình Phương gỏ phím enter cái tên này được nhập ngay vào ô B3, tại ô B4 muốn nhập tên Phạm Minh Tiến chỉ cần gỏ vào ô B4 P,H tool hiện list dần cho đến khi có tên Phạm Minh Tiến ta dời đến dòng Phạm Minh Tiến rồi gỏ enter cái tên Phạm Minh Tiến sẻ nhập ngay vào ô B4 cứ thế tiếp tục cho đến khi thôi hoặc hết vùng ô cần nhập tên, nếu muốn nhập tên cho sheet3 hoặc một sheet đang mở của một file excel đang mở khác chỉ việc chọn khối ô của sheet đó rồi bấm nút nạp vùng nhập tên để nhập tên tiếp, khi thôi nhập nữa bấm nút thoát X của tool.

Một lần nữa xin anh Trọng Nghĩa cùng các anh chị và các bạn thương giúp em nhé, em rất chân thành cám ơn.
 

File đính kèm

Lần chỉnh sửa cuối:
Mến chào anh Trọng Nghĩa các anh chị và các bạn!
Trải qua thời gian dùng tool TimTenTool.rar của anh Trọng Nghĩa em thấy tool này rất hay, nay em thấy nó không chỉ dừng lại ở chức năng tìm tên nhanh mà nó còn có thể dùng nhập tên nhanh và chính xác nữa, nhưng em không biết lập trình nên em nhờ anh Trọng Nghĩa và các anh chị giúp đở ạ.

Cụ thể em muốn có một cái tool addin tương tự như TimTenTool của anh Trọng Nghĩa,tool gồm có một listbox,nút nạp list và nút nạp vùng nhập tên. Em lấy file toolnhapten để minh họa.

Tại sheet danh sách bấm phím tắc(phím nóng) cho tool hiện ra, trên tool có 1 nút nạp list và 1 nút nạp vùng nhập tênlistbox. Nhấp chọn ô B1 bấm nút nạp list,nguyên danh sách tên từ ô B2(Nguyễn Hải Chi) trở xuống được nạp vào tool. Tiếp đến tại sheet2 (hoặc một sheet bất kỳ của file excel khác đang mở), quét 1 khối ô bất kỳ cần nhập tên cụ thể là B3:B23, rồi bấm nút nạp vùng nhập tên , tool sẻ ghi nhận hiểu những ô này cần nhập tên từ list của tool, tại vùng cần nhập tên: ô B3 ta muốn nhập tên Phan Đình Phương chỉ cần gỏ P,H,A tool xổ list hiện dần cho đến khi ta thấy tên cần tìm Phan Đình Phương, ta chỉ cần dời chọn đến Phan Đình Phương gỏ phím enter cái tên này được nhập ngay vào ô B3, tại ô B4 muốn nhập tên Phạm Minh Tiến chỉ cần gỏ vào ô B4 P,H tool hiện list dần cho đến khi có tên Phạm Minh Tiến ta dời đến dòng Phạm Minh Tiến rồi gỏ enter cái tên Phạm Minh Tiến sẻ nhập ngay vào ô B4 cứ thế tiếp tục cho đến khi thôi hoặc hết vùng ô cần nhập tên, nếu muốn nhập tên cho sheet3 hoặc một sheet đang mở của một file excel đang mở khác chỉ việc chọn khối ô của sheet đó rồi bấm nút nạp vùng nhập tên để nhập tên tiếp, khi thôi nhập nữa bấm nút thoát X của tool.

Một lần nữa xin anh Trọng Nghĩa cùng các anh chị và các bạn thương giúp em nhé, em rất chân thành cám ơn.
Tôi làm một cái form, khi form được load lên thì nó đã nhập tên trong sheet DanhSach vào trong combobox. Gõ tên hay bấm cho xổ xuống tên cần chọn, sau đó chọn ô nào muốn nhập tên rồi bấm nút. Khi form đang show, bạn có thể chọn bất cứ sheet nào hoặc sheet của bất cứ file nào đang mở để nhập tên cũng được! Thế thôi.

Toàn bộ Code thế này:

Mã:
Option Explicit
Private ArrDanhSach, ubd As Long

Private Sub UserForm_Initialize()
    ArrDanhSach = Range(DanhSach.Range("B2"), DanhSach.Range("B65536").End(xlUp))
    ubd = UBound(ArrDanhSach)
    ComboBox1.List = ArrDanhSach
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode <> 1 Then Cancel = 1
End Sub

Private Sub ComboBox1_Change()

    If ComboBox1 > "" Then
        ComboBox1.DropDown
    End If
    
    Dim strType As String
    Dim n As Long, r As Long
    Dim ArrFilter()

    ReDim ArrFilter(1 To ubd)
    strType = "*" & UCase(ComboBox1) & "*"
    For r = 1 To ubd
        If UCase(ArrDanhSach(r, 1)) Like strType Then
            n = n + 1
            ArrFilter(n) = ArrDanhSach(r, 1)
        End If
    Next
    
    If n Then
        ReDim Preserve ArrFilter(1 To n)
        ComboBox1.List = ArrFilter
    End If
    
End Sub

Private Sub CommandButton1_Click()
    If Trim(ComboBox1) = "" Then
        MsgBox "Ban phai nhap ten vao ComboBox"
    Else
        Selection = ComboBox1
        ComboBox1 = ""
    End If
    ComboBox1.SetFocus
End Sub

Private Sub CommandButton2_Click()
    ComboBox1 = ""
    Me.Hide
End Sub

Xin tải file ở bài sau!
 
Lần chỉnh sửa cuối:
Tôi làm một cái form, khi form được load lên thì nó đã nhập tên trong sheet DanhSach vào trong combobox. Gõ tên hay bấm cho xổ xuống tên cần chọn, sau đó chọn ô nào muốn nhập tên rồi bấm nút. Khi form đang show, bạn có thể chọn bất cứ sheet nào hoặc sheet của bất cứ file nào đang mở để nhập tên cũng được! Thế thôi.

Toàn bộ Code thế này:

Mã:
Option Explicit
Private ArrDanhSach, ubd As Long

Private Sub UserForm_Initialize()
    ArrDanhSach = Range(DanhSach.Range("B2"), DanhSach.Range("B65536").End(xlUp))
    ubd = UBound(ArrDanhSach)
    ComboBox1.List = ArrDanhSach
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode <> 1 Then Cancel = 1
End Sub

Private Sub ComboBox1_Change()

    If ComboBox1 > "" Then
        ComboBox1.DropDown
    End If
    
    Dim strType As String
    Dim n As Long, r As Long
    Dim ArrFilter()

    ReDim ArrFilter(1 To ubd)
    strType = "*" & UCase(ComboBox1) & "*"
    For r = 1 To ubd
        If UCase(ArrDanhSach(r, 1)) Like strType Then
            n = n + 1
            ArrFilter(n) = ArrDanhSach(r, 1)
        End If
    Next
    
    If n Then
        ReDim Preserve ArrFilter(1 To n)
        ComboBox1.List = ArrFilter
    End If
    
End Sub

Private Sub CommandButton1_Click()
    If Trim(ComboBox1) = "" Then
        MsgBox "Ban phai nhap ten vao ComboBox"
    Else
        Selection = ComboBox1
        ComboBox1 = ""
    End If
    ComboBox1.SetFocus
End Sub

Private Sub CommandButton2_Click()
    ComboBox1 = ""
    Me.Hide
End Sub

À, bạn thêm thủ tục này vào trong form nữa nhé! Đây là thủ tục để lấy lại Array nếu ArrDanhSach bị "đuối":

Mã:
Private Sub UserForm_Activate()
    If Not IsArray(ArrDanhSach) Then
        ArrDanhSach = Range(DanhSach.Range("B2"), DanhSach.Range("B65536").End(xlUp))
        ubd = UBound(ArrDanhSach)
        ComboBox1.List = ArrDanhSach
    End If
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
hong loi đã viết:
hoàng trọng nghĩa đã viết:
ok, tôi đã thực hiện cho bạn rồi đấy! Dao này tôi bận việc nhiều lắm, không có thời gian nhiều để trả lời!

chào anh trọng nghĩa ! Em biết anh rất bận nhưng em xin anh ít phút để đọc nhé.

đáng lẻ em nên post yêu cầu lên giao diện web nhưng sợ bị anh la rầy ê mặt với các thành viên khác, vì vậy em quyết định gửi bên này, có bị trách cũng không sao anh há.

Em rất vui:clap2: Cám ơn anh lắm nhe, dù không có thời gian nhưng anh vẫn rất nhiệt tình giúp em, form anh làm rất hay.

Cái hay thứ nhất form chạy nhanh nhẹ ghê luôn.

Cái hay thứ 2 là khi nhập xong một tên, combobox cũng được tự động xóa sạch nội dung sẳn sàng cho gỏ một tên mới mà không cần phải xóa bằng tay như ở combobox của tool tìm tên nhanh.

Cái hay thứ 3 khi form đã hiện ra thì được dùng chung thoải mái cho tất cả các sheet các file đang mở.

Cái hay thứ 4 khi tên được chọn vào combobox gỏ enter 2 lần là tên đó cũng được nhập vào ô đã chọn.

Còn giao diện form không cần phải nói nhiều, đẹp gọn khỏi chê luôn.

Bên cạnh những cái hay trên em thấy nếu được cải thiện thêm đôi chúc thì form càng đặc sắc hơn.

Thứ nhất lúc gỏ tên vào combobox, khi thấy tên trong list, thay vì dùng chuột click chọn tên vào combobox anh giúp em thêm cách chọn tên bằng bộ phím lên xuống qua lại trên bàn phím,cách chọn này anh có làm rồi trong tool tìm tên nhanh.

Thứ 2 cái này “được voi đòi hai bà trưng đây” : Anh có thể viết thêm 1 thủ tục để khi tên vừa nhập vào ô đã chọn, xong kế tiếp cái khung chọn ô tự động dời xuống ô kế dưới.

Ví dụ : ở sheet2 file nhaptenvaosheet khi vừa nhập xong tên phan đình phương vào ô b3 thì khung chọn từ ô b3 tự động dời xuống ô b4, như vậy khi nhập tên phạm minh tiến vào b4 ta không cần dời bằng tay cái khung chọn từ b3 xuống b4,nhập xong phạm minh tiến vào b4 khung lại tự động xuống ô b5….

Thứ 3 cái này “đòi lên đỉnh olpimpia luôn nè” thay vì em nhờ anh cải tiến nâng cấp lại form nhập tên trên file nhaptenvaosheet, anh có thể làm lại cái mới dưới dạng cái file addin như anh đã làm cho em dùng tìm tên nhanh không ?, file timtentool.rar ở mục số #43 đó. Em xin trích mục số #41 nguyên văn đoạn này để diễn giải cho anh hiểu rỏ yêu cầu của em:” bạn không cần mở file addins này đâu, khi mở bất kỳ file nào thì nó cũng đã mở (ngầm) trước rồi vì thế chỉ cần thực hiện thao tác thôi.

khi cần chọn cột cần tìm nào, bạn đặt con trỏ về ô đầu tiên của khối dữ liệu, ví dụ khối họ tên của bạn có họ tên đầu tiên ở ô b3 thì bạn đặt con trỏ tại ô b3 là ô hiện hành, sau đó bấm tổ hợp phím ctrl+shift+s để cho hiện form.

tại form có 1 textbox ghi lại địa chỉ ô hiện hành (bạn có thể thay đổi ô này nếu bạn muốn chọn cột khác), sau đó bạn chỉ bấm enter hoặc nhấn vào nút tạo list.

lúc này trên form sẽ xuất hiện combobox và list danh sách đã được nạp vào, bạn chỉ việc gõ và enter để tìm nhanh thôi.

bất kỳ file nào bạn muốn tìm kiếm đều được, không chỉ riêng 2 file đâu, chỉ cần cài đặt addins như đã hướng dẫn!”


nếu làm được cái addin giống như vậy thì sẻ thêm những tiện lợi sau:

- form sẻ nhập bất cứ danh sách ở cột nào của sheet nào đang mở chứ không chỉ là danh sách từ file nhaptenvaosheet.

- như vậy cứ mổi lần cần nhập tên không nhất thiếc phải mở file nhaptenvaosheet lên thì mới nhập cho sheet khác được.

- bỏ qua bước enable macro khi mở file.

Vậy đó anh trọng nghĩa ơi xin anh giành chút thời gian quí báo “ra tay” giúp em lần nữa nhe em rất biết ơn anh ạ.

Bạn làm ơn cái gì hỏi thì hỏi thẳng trên đây, đừng mất công viết tin nhắn riêng nữa nhé!

Theo như tôi nghĩ thì bạn cần làm một cái file AddIns. Mà đã là file dạng này thì chỉ nên chứa code thực thi, chứ không có dữ liệu gì trong đó. Vì vậy tôi phải sửa lại tất cả code đã viết cho bạn.

Trước hết sau khi bạn tải về, chép vào thư mục Addins như đã hướng dẫn ở bài #40 (lần này check vào NhapTenVaoSheet)

Để sử dụng, bấm phím tắt Ctrl+Shift+Z để load form.

Khi form mở lên, list chưa được nạp nên có một thông báo nhắc bạn phải nạp danh sách vào list.

Để nạp danh sách, bạn mở sheet có chứa danh sách ra, chọn vào ô đầu tiên chứa họ tên của danh sách rồi bấm nút ADD LIST (dĩ nhiên nó cũng sẽ hỏi gì gì đó để xác định việc add list này).

Khi đã có danh sách rồi thì form sẽ không hiện thông báo mỗi khi mở form nữa, nhưng nó sẽ lại thông báo nếu biến mảng bị giải phóng.

Bạn cũng có thể thay đổi danh sách mới bằng cách Add vào danh sách khác.

Khi list đã được Add thì ComboBox mới được sử dụng. Bạn chọn tên trên list của nó, chọn ô cần nhập tên, bấm vào nút lệnh. Lúc này ô được chọn sẽ được nhập, đồng thời cũng tự xuống hàng để bạn nhập tên khác, khỏi mất công phải chọn tới chọn lui.

Sau đây là toàn bộ code của file:

Mã:
Option Explicit
Private ArrDanhSach, ubd As Long


Private Sub UserForm_Activate()
    If Not IsArray(ArrDanhSach) Then
        Application.OnTime Now + TimeValue("0:0:1"), "AddListWarning"
        cbxDanhSach.Enabled = False
    End If
End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode <> 1 Then Cancel = 1
End Sub


Private Sub cbxDanhSach_Change()
    If cbxDanhSach > "" Then
        cbxDanhSach.DropDown
    End If
    Dim strType As String
    Dim n As Long, r As Long
    Dim ArrFilter()
    ReDim ArrFilter(1 To ubd)
    strType = "*" & UCase(cbxDanhSach) & "*"
    For r = 1 To ubd
        If UCase(ArrDanhSach(r, 1)) Like strType Then
            n = n + 1
            ArrFilter(n) = ArrDanhSach(r, 1)
        End If
    Next
    If n Then
        ReDim Preserve ArrFilter(1 To n)
        cbxDanhSach.List = ArrFilter
    End If
End Sub


Private Sub cmdAddList_Click()
    If cbxDanhSach.ListCount = 0 Then
AddList:
        Dim r As Long, c As Long, endRow As Long
        r = Selection.Row
        c = Selection.Column
        endRow = Cells(65536, c).End(xlUp).Row
        If endRow < r Then
            MsgBox "Danh sach khong kha dung!" & vbLf & _
            "Ban phai chon lai ten dau tien cua danh sach."
        Else
            If MsgBox("Ban co chac nap vao list danh sach nay khong?", _
                vbQuestion + vbYesNo, "Thông báo") = vbYes Then
                ArrDanhSach = Range(Cells(r, c), Cells(endRow, c))
                ubd = UBound(ArrDanhSach)
                cbxDanhSach.List = ArrDanhSach
                cbxDanhSach.Enabled = True
                cbxDanhSach.SetFocus
            End If
        End If
    Else
        If MsgBox("Danh sach da duoc nap roi, ban co chac nap lai danh sach moi khong?", _
            vbQuestion + vbYesNo, "Thông báo") = vbYes Then
            GoTo AddList
        End If
    End If
End Sub


Private Sub cmdNhapTen_Click()
    If cbxDanhSach.ListCount = 0 Then
        Call AddListWarning
        Exit Sub
    End If
    If Trim(cbxDanhSach) = "" Then
        MsgBox "Ban phai nhap ten vao ComboBox"
    Else
        Selection = cbxDanhSach
        cbxDanhSach = ""
        Selection.Offset(1).Select
    End If
    cbxDanhSach.SetFocus
End Sub


Private Sub cmdHide_Click()
    cbxDanhSach = ""
    Me.Hide
End Sub

=================================================
P/s: Tăng cường cho bạn thêm 2 nút "điều hướng", để điều khiển trên sheet, bạn bấm vào nút mũi tên một lần sẽ theo chiều mũi tên mà lên xuống hoặc qua lại 1 ô, nếu nhấn và giữ thì nó chạy cho đến khi nào bạn buông ra thì thôi.
 

File đính kèm

Lần chỉnh sửa cuối:
:clapping::clapping::clapping:Vui ơi là vui ! , cám ơn anh Trọng Nghĩa nhiều lắm nhe, file addin anh làm very good y như dân chuyên nghiệp làm vậy vượt qua mong đợi của em luôn, à anh Trọng Nghĩa ơi hình như anh bỏ xót yêu cầu chọn tên trong list xổ ra bằng các phím lên xuống qua lại trên bàn phím, trong yêu cầu thứ nhất đó anh.

Em xin giải thích thêm vì sao em lại thích kiểu chọn bằng bàn phím nhé.

Khi ta gỏ tên cần tìm đương nhiên bàn tay phải ở nơi bàn phím,như vậy khi list xổ ra ta chỉ cần xê dịch ngón tay đến vị trí bộ phím lên xuống qua lại, bấm phím xuống hoặc lên để di chuyển dòng chọn tên màu xanh trên list đến tên cần nhập.

Bây giờ bàn tay vẫn còn ở bàn phím và rất gần với phím enter,nếu như có thể gỏ enter 1 hoặc 2 lần là tên được nhập vào ô, thì ta có một cái lợi là rút ngắn phạm vi hoặc động của đôi tay đồng nghĩa với việc giúp ta điều khiển dể dàng rút ngắn thời giang và tăng tốc độ nhập tên lên thêm nhiều nhất là khi cần nhập một danh sách dài.

Em có tìm 2 đoạn code từ tool tìm tên nhanh và tool mới làm nhaptenvaosheet của anh

Private Sub cbxDanhSach_Change()
If cbxDanhSach > "" Then
cbxDanhSach.DropDown
End If
Dim strType As String
Dim n As Long, r As Long
Dim ArrFilter()
ReDim ArrFilter(1 To ubd)
strType = "*" & UCase(cbxDanhSach) & "*"
For r = 1 To ubd
If UCase(ArrDanhSach(r, 1)) Like strType Then
n = n + 1
ArrFilter(n) = ArrDanhSach(r, 1)
End If
Next
If n Then
ReDim Preserve ArrFilter(1 To n)
cbxDanhSach.List = ArrFilter
End If
End Sub




Private Sub ComboBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error GoTo XuLyLoi
With ComboBox1
Select Case KeyCode
Case 8
If .Text = "" Then
.List = sArray: Exit Sub
Else
GoTo CaseElse
End If
Case 13
If .MatchFound = True Then
FindRange.Find(.Text, LookIn:=xlValues, LookAt:=xlWhole).Select
'Unload Me
Exit Sub
End If
Case 37 To 40: Exit Sub
Case Else
CaseElse:
.List = Filter2DArray(sArray, 1, "*" & .Text & "*", False)
End Select
Exit Sub
XuLyLoi:
.List = Array("")
.Clear
End With
End Sub

Không biết có phải là phần em đang nói đến hay không, vì không biết lập trình nên em không dám chạm vào lở hư là đi têu công sức của anh.
 
Lần chỉnh sửa cuối:
:clapping::clapping::clapping:Vui ơi là vui ! , cám ơn anh Trọng Nghĩa nhiều lắm nhe, file addin anh làm very good y như dân chuyên nghiệp làm vậy vượt qua mong đợi của em luôn, à anh Trọng Nghĩa ơi hình như anh bỏ xót yêu cầu chọn tên trong list xổ ra bằng các phím lên xuống qua lại trên bàn phím, trong yêu cầu thứ nhất đó anh.

Em xin giải thích thêm vì sao em lại thích kiểu chọn bằng bàn phím nhé.

Khi ta gỏ tên cần tìm đương nhiên bàn tay phải ở nơi bàn phím,như vậy khi list xổ ra ta chỉ cần xê dịch ngón tay đến vị trí bộ phím lên xuống qua lại, bấm phím xuống hoặc lên để di chuyển dòng chọn tên màu xanh trên list đến tên cần nhập.

Bây giờ bàn tay vẫn còn ở bàn phím và rất gần với phím enter,nếu như có thể gỏ enter 1 hoặc 2 lần là tên được nhập vào ô, thì ta có một cái lợi là rút ngắn phạm vi hoặc động của đôi tay đồng nghĩa với việc giúp ta điều khiển dể dàng rút ngắn thời giang và tăng tốc độ nhập tên lên thêm nhiều nhất là khi cần nhập một danh sách dài.

Bạn giải thích dài dòng mà tôi chẳng hiểu rõ ý bạn dùng nút mũi tên để làm gì ở những bài trước! Giờ mới hiểu ý của bạn đó! Chẳng khó gì đâu, thay thằng Change bằng thằng KeyUp thôi!

Mã:
[COLOR=#0000ff]''Tranh phai Filter khi su dung cac nut chuc nang:[/COLOR]
Private Sub cbxDanhSach_Change()
    IsChange = True
End Sub


Private Sub cbxDanhSach_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
[COLOR=#008080]    If IsChange = False Then Exit Sub
    IsChange = False[/COLOR]
    Select Case KeyCode
    Case 9, 13, 37 To 40
    Case Else
        If cbxDanhSach > "" Then
            cbxDanhSach.DropDown
        End If
        Dim strType As String
        Dim n As Long, r As Long
        Dim ArrFilter()
        ReDim ArrFilter(1 To Ubd)
        strType = "*" & UCase(cbxDanhSach) & "*"
        For r = 1 To Ubd
            If UCase(ArrDanhSach(r, 1)) Like strType Then
                n = n + 1
                ArrFilter(n) = ArrDanhSach(r, 1)
            End If
        Next
        If n Then
            ReDim Preserve ArrFilter(1 To n)
            cbxDanhSach.List = ArrFilter
        Else
            cbxDanhSach.List = Array("")
        End If
    End Select
End Sub

Bổ sung vào nút nhập:

Mã:
Private Sub cmdAddList_Click()
    If cbxDanhSach.ListCount = 0 Then
AddList:
        Dim r As Long, c As Long, endRow As Long
        r = Selection.Row
        c = Selection.Column
        endRow = Cells(65536, c).End(xlUp).Row
        If endRow < r Then
            MsgBox "Danh sach khong kha dung!" & vbLf & _
            "Ban phai chon lai ten dau tien cua danh sach."
        Else
            If MsgBox("Ban co chac nap vao list danh sach nay khong?", _
                vbQuestion + vbYesNo, "Thông báo") = vbYes Then
                ArrDanhSach = Range(Cells(r, c), Cells(endRow, c))
[COLOR=#0000ff]                ''Truong hop vung duoc chon chi co 1 o duy nhat:[/COLOR]
                If Not IsArray(ArrDanhSach) Then
[COLOR=#0000ff]                    ''Ma o nay lai rong:[/COLOR]
                    If ArrDanhSach = "" Then
                        MsgBox "Danh sach khong kha dung!" & vbLf & _
                        "Ban phai chon lai ten dau tien cua danh sach."
                        Exit Sub
                    Else
[COLOR=#0000ff]                        ''Neu khong thi danh sach cung duoc cap nhat voi 1 ten:[/COLOR]
                        ReDim ArrDanhSach(1 To 1, 1 To 1)
                        ArrDanhSach(1, 1) = Range(Cells(r, c), Cells(endRow, c))
                    End If
                End If
                Ubd = UBound(ArrDanhSach)
                cbxDanhSach.List = ArrDanhSach
                cbxDanhSach.Enabled = True
                cbxDanhSach.SetFocus
            End If
        End If
    Else
        If MsgBox("Danh sach da duoc nap roi, ban co chac nap lai danh sach moi khong?", _
            vbQuestion + vbYesNo, "Thông báo") = vbYes Then
            GoTo AddList
        End If
    End If
End Sub


Xóa file cũ đi, thay vào file mới này! Lưu ý, nút nhập rất nhạy khi bạn bấm Enter đấy nhé! (giảm cho bạn 1 lần Enter đấy).
 

File đính kèm

Lần chỉnh sửa cuối:
Ôi! anh Trọng Nghĩa ơi vậy là yêu cầu của em đã thành hiện thực cả rồi em hạnh phúc quá anh ạ, em thấy em rất may mắn gặp được một người vừa giỏi vừa tốt như anh. Cám ơn anh nhiều nhé.

"việc hôm nay không nên để đến ngày mai" nhưng nếu công việc nhiều quá phải để ngày mai làm tiếp chứ anh đừng thức khuya rất có hại cho sức khỏe, sức khỏe mất đi dù có vàng bạc châu báu củng chưa chắc mua lại được đâu anh.
 
Anh Trọng Nghĩa ơi cho em hỏi thêm một tí nhe, ở cái addin tìm tên timtentool TimTenTool.rar mục #43
khi gõ tên tìm xong, muốn gõ tiếp ta phải xóa bằng tay cái tên củ trong combobox mới gõ tên khác tìm tiếp như vậy hơi thừa thao tác, không biết anh có thể thêm một thủ tục để sau khi gỏ enter khung chọn chỉ đúng tên rồi thì thủ tục này sẻ tự động xóa sạch tên củ trong combobox sẵn sàng cho ta gõ tên mới.

Có phải sửa lại code này không anh ?
Private Sub ComboBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error GoTo XuLyLoi
With ComboBox1
Select Case KeyCode
Case 8
If .Text = "" Then
.List = sArray: Exit Sub
Else
GoTo CaseElse
End If
Case 13
If .MatchFound = True Then
FindRange.Find(.Text, LookIn:=xlValues, LookAt:=xlWhole).Select
'Unload Me
Exit Sub
End If
Case 37 To 40: Exit Sub
Case Else
CaseElse:
.List = Filter2DArray(sArray, 1, "*" & .Text & "*", False)
End Select
Exit Sub
XuLyLoi:
.List = Array("")
.Clear
End With
End Sub
 
Lần chỉnh sửa cuối:
Anh Trọng Nghĩa ơi cho em hỏi thêm một tí nhe, ở cái addin tìm tên timtentool TimTenTool.rar mục #43
khi gõ tên tìm xong, muốn gõ tiếp ta phải xóa bằng tay cái tên củ trong combobox mới gõ tên khác tìm tiếp như vậy hơi thừa thao tác, không biết anh có thể thêm một thủ tục để sau khi gỏ enter khung chọn chỉ đúng tên rồi thì thủ tục này sẻ tự động xóa sạch tên củ trong combobox sẵn sàng cho ta gõ tên mới.

Có phải sửa lại code này không anh ?
Giờ mới đọc bài này! (đã cùi rồi cho lở luôn chứ biết làm sao với bạn bây giờ!).

Tại ngay cái file đó, bạn thêm cái dòng đỏ vào là xong!

Mã:
Private Sub ComboBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
      On Error GoTo XuLyLoi
      With ComboBox1
            Select Case KeyCode
                  Case 8
                        If .Text = "" Then
                              .List = sArray: Exit Sub
                        Else
                              GoTo CaseElse
                        End If
                  Case 13
                        If .MatchFound = True Then
                              FindRange.Find(.Text, LookIn:=xlValues, LookAt:=xlWhole).Select
[COLOR=#ff0000][B]                              .Text = ""[/B][/COLOR]
                              Exit Sub
                        End If
                  Case 37 To 40: Exit Sub
                  Case Else
CaseElse:
                  .List = Filter2DArray(sArray, 1, "*" & .Text & "*", False)
            End Select
            Exit Sub
XuLyLoi:
            .List = Array("")
            .Clear
      End With
End Sub

Đơn giản thế mà bạn cũng không thực hiện được nữa, hic ... hic ... hic.
 
Giờ mới đọc bài này! (đã cùi rồi cho lở luôn chứ biết làm sao với bạn bây giờ!).

Tại ngay cái file đó, bạn thêm cái dòng đỏ vào là xong!

Mã:
Private Sub ComboBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
      On Error GoTo XuLyLoi
      With ComboBox1
            Select Case KeyCode
                  Case 8
                        If .Text = "" Then
                              .List = sArray: Exit Sub
                        Else
                              GoTo CaseElse
                        End If
                  Case 13
                        If .MatchFound = True Then
                              FindRange.Find(.Text, LookIn:=xlValues, LookAt:=xlWhole).Select
[COLOR=#ff0000][B]                              .Text = ""[/B][/COLOR]
                              Exit Sub
                        End If
                  Case 37 To 40: Exit Sub
                  Case Else
CaseElse:
                  .List = Filter2DArray(sArray, 1, "*" & .Text & "*", False)
            End Select
            Exit Sub
XuLyLoi:
            .List = Array("")
            .Clear
      End With
End Sub

Đơn giản thế mà bạn cũng không thực hiện được nữa, hic ... hic ... hic.

Ồ! hay quá chỉ đơn giãn thế hả anh thế mà anh lại cho em chờ từng ngày, từng ngày... đây nè, hì...hì...hì ,nói đùa thôi nhé em biết anh bận rộn lắm.

Nói thật với anh em đã tìm hoa cả mắt mấy cái code anh tạo ở trên nhưng vẫn không thể đoán được hàng code nào liên quan đến phần xóa nội dung trong combobox. Nay anh hướng dẫn em làm được rồi, càng tiếp xúc với anh em thấy mình càng ngu càng nhỏ bé lại.

Cám ơn Trọng Nghĩa lắm nhe, nhờ có "lở cùi" anh đã giúp em mở rộng tầm nhìn, giúp em tiến bộ hơn rất nhiều.
 
Em tìm được cách sử dụng rồi. Cám ơn các anh nhé. Em cũng là một số 0. Nhưng khi phải bắt tay vào xây dựng một ứng dụng quản lý hồ sơ của dự án thì phải lên GPE hỏi liên tục. Giờ ứng dụng cũng gần xong. Nhìn lại có 2 tuần từ ban đầu không biết code là gì mà giờ không nghĩ là mình thay đổi nhanh đến thế. Cảm ơn GPE và những người tâm huyết giúp đỡ mọi người như anh Hoàng Trọng Nghĩa.
 
Lần chỉnh sửa cuối:
quote_icon.png
Nguyên văn bởi Hoàng Trọng NghĩaTôi làm một cái form, khi form được load lên thì nó đã nhập tên trong sheet DanhSach vào trong combobox. Gõ tên hay bấm cho xổ xuống tên cần chọn, sau đó chọn ô nào muốn nhập tên rồi bấm nút. Khi form đang show, bạn có thể chọn bất cứ sheet nào hoặc sheet của bất cứ file nào đang mở để nhập tên cũng được! Thế thôi.

Toàn bộ Code thế này:

Code:
Option Explicit
Private ArrDanhSach, ubd As Long

Private Sub UserForm_Initialize()
ArrDanhSach = Range(DanhSach.Range("B2"), DanhSach.Range("B65536").End(xlUp))
ubd = UBound(ArrDanhSach)
ComboBox1.List = ArrDanhSach
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode <> 1 Then Cancel = 1
End Sub

Private Sub ComboBox1_Change()

If ComboBox1 > "" Then
ComboBox1.DropDown
End If

Dim strType As String
Dim n As Long, r As Long
Dim ArrFilter()

ReDim ArrFilter(1 To ubd)
strType = "*" & UCase(ComboBox1) & "*"
For r = 1 To ubd
If UCase(ArrDanhSach(r, 1)) Like strType Then
n = n + 1
ArrFilter(n) = ArrDanhSach(r, 1)
End If
Next

If n Then
ReDim Preserve ArrFilter(1 To n)
ComboBox1.List = ArrFilter
End If

End Sub

Private Sub CommandButton1_Click()
If Trim(ComboBox1) = "" Then
MsgBox "Ban phai nhap ten vao ComboBox"
Else
Selection = ComboBox1
ComboBox1 = ""
End If
ComboBox1.SetFocus
End Sub

Private Sub CommandButton2_Click()
ComboBox1 = ""
Me.Hide
End Sub

/cod[e]

À, bạn thêm thủ tục này vào trong form nữa nhé! Đây là thủ tục để lấy lại Array nếu ArrDanhSach bị "đuối":

Code:
Private Sub UserForm_Activate()
If Not IsArray(ArrDanhSach) Then
ArrDanhSach = Range(DanhSach.Range("B2"), DanhSach.Range("B65536").End(xlUp))
ubd = UBound(ArrDanhSach)
ComboBox1.List = ArrDanhSach
End If
End Sub

Mến chào anh Trọng Nghĩa! Nếu có thời gian anh xem giúp em cái bài này nhé.

Em nhận thấy trong trường hợp chỉ dùng duy nhất một danh sách cho duy nhất một file thì form NhapTenVaoSheet.xls#49 là chọn lựa hay nhất. Nhưng do form này chưa được cải tiến vì vậy em “săn quần săn áo làm liều xuống ao mò…code ” cuối cùng em làm như thế này.

Để đổi chức năng chọn tên bằng chuột qua bằng bàn phím em đổi code này

Private Sub ComboBox1_Change() If ComboBox1 > "" Then ComboBox1.DropDown End If Dim strType As String Dim n As Long, r As Long Dim ArrFilter() ReDim ArrFilter(1 To ubd) strType = "*" & UCase(ComboBox1) & "*" For r = 1 To ubd If UCase(ArrDanhSach(r, 1)) Like strType Then n = n + 1 ArrFilter(n) = ArrDanhSach(r, 1) End If Next If n Then ReDim Preserve ArrFilter(1 To n) ComboBox1.List = ArrFilter End If End Sub
Thành code này

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

Select Case KeyCode
Case 9, 13, 37 To 40
Case Else
If ComboBox1 > "" Then
ComboBox1.DropDown
End If
Dim strType As String
Dim n As Long, r As Long
Dim ArrFilter()
ReDim ArrFilter(1 To ubd)
strType = "*" & UCase(ComboBox1) & "*"
For r = 1 To ubd
If UCase(ArrDanhSach(r, 1)) Like strType Then
n = n + 1
ArrFilter(n) = ArrDanhSach(r, 1)
End If
Next
If n Then
ReDim Preserve ArrFilter(1 To n)
ComboBox1.List = ArrFilter
Else
ComboBox1.List = Array("")
End If
End Select
End Sub

Em đã xóa đi cái này
If IsChange = False Then Exit Sub
IsChange = False

vì để vào là bị báo lổi code khi gỏ chử vào combobox.

Để tự xuống dòng em thay code

Private Sub CommandButton1_Click() If Trim(ComboBox1) = "" Then MsgBox "Ban phai nhap ten vao ComboBox" Else Selection = ComboBox1 ComboBox1 = "" End If ComboBox1.SetFocusEnd Sub

Bằng code này
Private Sub CommandButton1_Click()
If Trim(ComboBox1) = "" Then
MsgBox "Ban phai nhap ten vao ComboBox"
Else
Selection = ComboBox1
ComboBox1 = ""
Selection.Offset(1).Select
End If
ComboBox1.SetFocus
End Sub

Để giảm bớt một lần enter hì..hì…bó tay không tìm ra.

Kết quả form vẫn chạy nhưng khi gõ chữ list xổ ra không đúng qui tắc củ nữa ra lung tung, khi chọn tên bằng bàn phím nếu lở bấm giữ phím chạy xuống hơi lâu dòng chọn tên màu xanh trong list xuống tới cuối list thì list cũng mất tiêu luôn.
 

File đính kèm

Lần chỉnh sửa cuối:
Mến chào anh Trọng Nghĩa! Nếu có thời gian anh xem giúp em cái bài này nhé.

Em nhận thấy trong trường hợp chỉ dùng duy nhất một danh sách cho duy nhất một file thì form NhapTenVaoSheet.xls#49 là chọn lựa hay nhất. Nhưng do form này chưa được cải tiến vì vậy em “săn quần săn áo làm liều xuống ao mò…code ” cuối cùng em làm như thế này.


Để giảm bớt một lần enter hì..hì…bó tay không tìm ra.

Kết quả form vẫn chạy nhưng khi gõ chữ list xổ ra không đúng qui tắc củ nữa ra lung tung, khi chọn tên bằng bàn phím nếu lở bấm giữ phím chạy xuống hơi lâu dòng chọn tên màu xanh trong list xuống tới cuối list thì list cũng mất tiêu luôn.

Để code chạy đừng có "ra lung tung" thì bạn thay thủ tục KeyDown thành KeyUp:

Private Sub ComboBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

Thế là xong!

Để tiết kiệm 1 lần Enter, Chọn vào Nút lệnh, Properties chọn Default=True là xong! Ẹc ẹc ...
 
Để code chạy đừng có "ra lung tung" thì bạn thay thủ tục KeyDown thành KeyUp:

Private Sub ComboBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

Thế là xong!

Để tiết kiệm 1 lần Enter, Chọn vào Nút lệnh, Properties chọn Default=True là xong! Ẹc ẹc ...

Ha...Ha...@$@!^% dzời ơi vui quá em làm được rồi! Thật không ngờ anh Trọng Nghĩa có "nhiều chiêu" đơn giãn nhưng lại rất hay.

Một lần nữa em cám ơn anh nhiều nhe.
 
Web KT

Bài viết mới nhất

Back
Top Bottom