Tìm Kiếm Trong Data Validation Excel

Liên hệ QC

Kiều Mạnh

I don't program, I beat code into submission!!!
Tham gia
9/6/12
Bài viết
5,424
Được thích
4,036
Giới tính
Nam
Mình có viết code sau để tạo và sử dụng Data Validation trong Excel sử dụng tốt ...Tuy nhiên có 2 vấn đề phát sinh mà suy nghĩ hoài chua tìm ra cách xử lý ... Vậy úp bài nhờ các Bạn trợ giúp

1/ Vùng dữ liêu nguon() luôn luôn phát sinh nên mình sử dụng Dic để lấy duy nhất gán vào Data Validation ...nếu dữ liệu nhiều phải kéo xuống tìm mất công quá ... Vậy mình muốn hỏi có cách nào từ Sheet2.[C4] ta có thể gõ ký tự đại diện là nó tìm kiếm ra được hay không ?? .... để gán vào đó

2/ Khi mình sử dụng SendKeys ("%{Down}") để cho Data Validation nó xổ xuống cho dễ nhìn thì trên máy mình mất phím Numlock và có sử dụng Shell để bật nó lại tuy nhiên thấy nó cũng cứ nhảy link tinh à

Vậy nhờ các Bạn xem có cách nào khác xử lý tốt 2 vấn đề trên không giúp mình với
Xin cảm ơn
Mã:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Nguon()
    Nguon = Sheet1.Range(Sheet1.[B3], Sheet1.[B65536].End(3)).Value
    Call Validation(Nguon, Sheet2.Range("C4"))
    ''Call ON_Numlock
End Sub

Public Sub Validation(ByVal dArr As Variant, ByVal Target As Range)
    Dim i As Long
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(dArr)
            If Not IsEmpty(dArr(i, 1)) Then
                .Item(dArr(i, 1)) = .Count
            End If
        Next
        Target.Validation.Delete
        If .Count Then Target.Validation.Add 3, , , Join(.Keys, ",")
        ''SendKeys ("%{Down}")
    End With
End Sub

Sub ON_Numlock()
    CreateObject("WScript.Shell").SendKeys "{NUMLOCK}", True
End Sub
 

File đính kèm

  • Data Validation.xlsb
    17.3 KB · Đọc: 62
Lần chỉnh sửa cuối:
Em tải Delphi về tới lúc cài đặt nó đòi Serial Number thì không biết điền, mong anh Kieu Manh giúp đỡ!!!
 
Upvote 0
Upvote 0
quá nhọ rồi!, vừa tải xong Visual Studio 20Gb, Dephil 2Gb, máy treo (có đóng băng), khởi động lại, lại google tiếp nữa
dân quây thứ thiệt rồi ............Mạnh thì Ghost thôi ... có ngày Ghost 3 lần đó và Mạnh có 1 Mình chơi 2 máy mà .............. Mấy hôm quậy mấy con Virus tính bắt nhốt nó lại nhưng không được máy bị dính xong tải Norton chạy ... xong Kaskersky chạy hết xong Bung ghost ....***&&%--=0
 
Upvote 0
Đây là kết quả cuối cùng úp lên tặng cho Bạn nào cần thì cứ vậy mà xài ... code xúc tích ngắn gọn ... đơn giản ....

Và dễ hiểu kèm theo tham số của hàm InStr cho những ai mới bắt đầu VBA tìm hiểu

1/ Tại C4 bạn muốn gõ cái giống gì vào đó thì gõ xong Enter

2/ nếu Xóa trắng C4 thì nó lấy hết

3/ Quá trình xử dụng nếu có lỗi gì phát sinh vui lòng báo lại tại đây

4/ Mô tả Hàm InStr cho những Bạn mới làm quen với VBA ... Mạnh Copy từ Internet

Tên hàm:
InStr

Mô tả:
InStr([start, ]string1, string2[, compare])
Tìm chuỗi string2 trong chuỗi string1, tìm từ vị trí start

Tham số:
start
Vị trí tìm
string1
Chuỗi tìm kiếm
string2
Giá trị cần tìm
compare
Chỉ rõ kiểu dữ liệu để so sánh trong quá trình tìm kiếm

Ghi chú:
Dùng cho tham số compare
vbUseCompareOption = –1
Chế độ tùy chọn, VB sẽ tự động lựa lọai dữ liệu thích hợp
vbBinaryCompare = 0
So sánh nhị phân
vbTextCompare = 1
So sánh chuỗi
vbDatabaseCompare = 2
So sánh dữ liệu

Private Sub Form_Load()
Dim SearchString, SearchChar, MyPos
SearchString = "XXpXXpXXPXXP"' String to search in.
SearchChar = "P"' Search for "P".
' So sanh theo cua text tu vi tri 4
MyPos = InStr(4, SearchString, SearchChar, 1)' Returns 6.
' So sanh theo Binary
MyPos = InStr(1, SearchString, SearchChar, 0)' Returns 9.
' So sanh theo Binary, do mac dinh la 0
MyPos = InStr(SearchString, SearchChar)' Returns 9.
MyPos = InStr(1, SearchString, "W")' Returns 0.
End Sub

PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
        Dim Nguon()
        Nguon = Sheet1.Range(Sheet1.[B3], Sheet1.[B65536].End(3)).Value
        If Target.Address = [C4].Address Then
            If Target.Count = 1 Then
                Call GetListValidation(Nguon(), Sheet2.Range("C4"))
            End If
        End If
    Application.EnableEvents = True
End Sub
 
Public Sub GetListValidation(ByVal Arr As Variant, ByVal Target As Range)
    Dim Dic As Object, i As Long
    Set Dic = CreateObject("scripting.dictionary")
    For i = 1 To UBound(Arr)
        If InStr(1, UCase(Arr(i, 1)), UCase(Target.Value), 1) Then
            If Not IsEmpty(Arr(i, 1)) Then
                Dic.Item(Arr(i, 1)) = Dic.Count
            End If
        End If
    Next
    With Target.Validation
        .Delete
        If Dic.Count Then
            .Add 3, , , Join(Dic.keys, ",")
            .ShowError = False
        End If
        If Dic.Count > 1 Then
            SendKeys ("%{Down}"), True
        ElseIf Dic.Count = 1 Then
            Target.Value = Dic.keys()
        End If
        Target.Select
    End With
    Set Dic = Nothing
End Sub


miềng chạy thử lại thử hình như code bị lỗi 1 chỗ @@
 
Upvote 0
vậy chắc là lỗi thứ 2 !
đối với trường hợp danh sách có 1 từ như chữ (l) thì nó ra chữ (Lê) luôn
nhưng với trường hợp danh sách có nhiều mục thì nó ko xổ ra !
hay máy mình bị lỗi @@
 
Upvote 0
vậy chắc là lỗi thứ 2 !
đối với trường hợp danh sách có 1 từ như chữ (l) thì nó ra chữ (Lê) luôn
nhưng với trường hợp danh sách có nhiều mục thì nó ko xổ ra !
hay máy mình bị lỗi @@
vậy thì ko đúng khởi động lại máy xem
 
Upvote 0
ô C4 bác gõ thử chữ (c) thử , hoặc chữ (m)!
thôi ngủ phát ^^
 
Lần chỉnh sửa cuối:
Upvote 0
thử ở máy chỗ làm cũng bị ^^

upload_2017-7-22_8-13-27.png

upload_2017-7-22_8-12-48.png

nhập chữ m , ko enter mà click chuột thì ok @@

upload_2017-7-22_8-14-57.png
 
Upvote 0

File đính kèm

  • m.png
    m.png
    125.3 KB · Đọc: 4
Upvote 0
máy Mạnh ko bị vậy .............No biết tại sao ???!!!
anh dùng code như thế nào?
bạn ấy dùng code như thế nào?
nếu dùng onkey như em nói ở mấy bài trước thì ra y như của em, còn vẫn xử lý sự kiện select_change trên sheet thì nó vẫn như của bạn ấy thôi, cách này không thể nào làm con trỏ vẫn ở trong ô nhập liệu đang nhập rồi hiện list ra đâu, nó phải nhảy ô rồi mới hiện
 
Upvote 0
bài 59 hình như cũng bị !

upload_2017-7-22_8-31-7.png
 

File đính kèm

  • List Search_Validati 59.xlsb
    22.8 KB · Đọc: 10
Upvote 0
Upvote 0
Web KT
Back
Top Bottom