Cách dò tìm ký tự trên Excel (1 người xem)

[Trungpro04]

có bác nào biết sử công cụ dò tìm theo ký tự kiểu như search trên Google không
Em có cái code này nhưng không bít dùng
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xRg As Range
Dim xCell As Range
Dim xRgRtn As Range
On Error Resume Next
Application.EnableEvents = False
If Not Intersect(Target, Range("1:1")) Is Nothing Then
Set xRg = ActiveSheet.UsedRange
Set xRg = xRg(1).Offset(1, 0).Resize(xRg.Rows.Count, xRg.Columns.Count)
For Each xCell In xRg
If Left(xCell.Value, 1) = Target.Value Then
If xRgRtn Is Nothing Then
Set xRgRtn = xCell
Else
Set xRgRtn = Application.Union(xRgRtn, xCell)
End If
End If
Next
nhờ ae chỉ điểm thêm
If xRgRtn.Address = Target.Address Then
MsgBox "No matched cell found", , "KuTools For Excel"
Else
xRgRtn.Select
End If
End If
Application.EnableEvents = True
End Sub

 

[snow25]

có bác nào biết sử công cụ dò tìm theo ký tự kiểu như search trên Google không
Em có cái code này nhưng không bít dùng
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xRg As Range
Dim xCell As Range
Dim xRgRtn As Range
On Error Resume Next
Application.EnableEvents = False
If Not Intersect(Target, Range("1:1")) Is Nothing Then
Set xRg = ActiveSheet.UsedRange
Set xRg = xRg(1).Offset(1, 0).Resize(xRg.Rows.Count, xRg.Columns.Count)
For Each xCell In xRg
If Left(xCell.Value, 1) = Target.Value Then
If xRgRtn Is Nothing Then
Set xRgRtn = xCell
Else
Set xRgRtn = Application.Union(xRgRtn, xCell)
End If
End If
Next
nhờ ae chỉ điểm thêm
If xRgRtn.Address = Target.Address Then
MsgBox "No matched cell found", , "KuTools For Excel"
Else
xRgRtn.Select
End If
End If
Application.EnableEvents = True
End Sub

Bạn gửi cái file lên.Và nêu ví dụ ra.

 

[Trungpro04]

Bạn gửi cái file lên.Và nêu ví dụ ra.

Bạn gửi cái file lên.Và nêu ví dụ ra.

Ví dụ như file này mình muốn tìm ngươì họ Nguyễn