Các bạn giúp mình sửa đoạn code tìm kiếm Giống như Find Next trong Excel (1 người xem)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
congnguyen88

congnguyen88

Thành viên bị đình chỉ hoạt động
Thành viên bị đình chỉ hoạt động
Tham gia
22/7/14
Bài viết
355
Được thích
31
Mình có 1 file của công ty gồm nhiều mã hàng trùng nhau. Mình có viết 1 đoạn code để tìm ( giống như Ctrl + F nhấn nút Find Next trong excel ). mà code mình chỉ tìm thấy 1 tên đầu tiên và dừng lại không chạy tiếp. Cho mình hỏi sửa lại code chổ nào để Find Next những mã tiếp theo
* nếu trong cột C mã hàng không có mã tại ô E4 thì hiện thông báo Msbox("Mã hàng không tìm thay ")
* nêu trong cột C mã hàng có mã thì khi nhấn Find Next sẽ quét từ trên xuống dưới và Select lần lượt sau mổi lần click vào nút bấm Find next ( giống như Ctrl + F nhấn nút Find Next trong excel ) . Và khi kiếm tới mã của dòng cuối cùng nếu nhấn Find Next 1 lần nữa thì bắt đầu quét lại từ trên xuống dưới lại như ban đầu . Lưu ý tên mã hàng không phân biệt chữ hoa chử thường

Em xin cảm ơn các bạn, thầy cô giáo.
Mã: 
Sub timkiem()

On Error Resume Next
Dim i As Long, Tmp As String
For i = 4 To 5003  ' so dong can tim 1 den 5000 dong
    Tmp = Range("C" & i).Value  ' cot C
    If UCase(Tmp) = UCase(Range("E4").Value) Then
        Cells(i, 3).Select
    Else
       MsgBox ("Khong tim thay ma")
       Exit For
    End If
Next i

End Sub

1584937160288.png
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
congnguyen88 đã viết:
Mình có 1 file của công ty gồm nhiều mã hàng trùng nhau. Mình có viết 1 đoạn code để tìm ( giống như Ctrl + F nhấn nút Find Next trong excel ). mà code mình chỉ tìm thấy 1 tên đầu tiên và dừng lại không chạy tiếp. Cho mình hỏi sửa lại code chổ nào để Find Next những mã tiếp theo
* nếu trong cột C mã hàng không có mã tại ô E4 thì hiện thông báo Msbox("Mã hàng không tìm thay ")
* nêu trong cột C mã hàng có mã thì khi nhấn Find Next sẽ quét từ trên xuống dưới và Select lần lượt sau mổi lần click vào nút bấm Find next ( giống như Ctrl + F nhấn nút Find Next trong excel ) . Và khi kiếm tới mã của dòng cuối cùng nếu nhấn Find Next 1 lần nữa thì bắt đầu quét lại từ trên xuống dưới lại như ban đầu . Lưu ý tên mã hàng không phân biệt chữ hoa chử thường

Em xin cảm ơn các bạn, thầy cô giáo.
Mã: 
Sub timkiem()

On Error Resume Next
Dim i As Long, Tmp As String
For i = 4 To 5003  ' so dong can tim 1 den 5000 dong
    Tmp = Range("C" & i).Value  ' cot C
    If UCase(Tmp) = UCase(Range("E4").Value) Then
        Cells(i, 3).Select
    Else
       MsgBox ("Khong tim thay ma")
       Exit For
    End If
Next i

End Sub
Nhấp chuột vào đây để mở rộng...
Bạn chạy code dưới đây
Mã: 
Dim Mang, k

Sub timkiem()
Dim i As Long, j As Long, Tmp As String
If IsArray(Mang) = False Then
    ReDim Mang(1 To 5003)
    For i = 4 To 5003  ' so dong can tim 1 den 5000 dong
        Tmp = Range("C" & i).Value  ' cot C
        If UCase(Tmp) = UCase(Range("E4").Value) Then
            j = j + 1
            Mang(j) = i
        End If
    Next i
    If j Then ReDim Preserve Mang(1 To j)
End If
If Mang(1) = "" Then
    MsgBox "Khong tim thay"
Else
    k = k + 1
    j = (k - 1) Mod UBound(Mang) + 1
    i = Mang(j)
    Range("C" & i).Select
End If
End Sub
 
Upvote 0
Bạn chạy thử con macro này xem thích không(?)
PHP: 
Sub TimKiemNhieuLan()
Dim J As Long, Rws As Long, W As Integer
Dim MyAdd As String, Tmp As String
Dim Rng As Range, sRng As Range, Arr() As String

Rws = Cells(Rows.Count, "C").End(xlUp).Row
Set Rng = Range([C1], Cells(Rws, "C"))
ReDim Arr(1 To Rws, 1 To 1)
[E6].Resize(Rws).ClearContents
Set sRng = Rng.Find([e4].Value, , xlFormulas, xlWhole)
If sRng Is Nothing Then
    MsgBox "Nothing!", , "GPE.COM Xin Thông Báo:"
Else
    MyAdd = sRng.Address
    Do
        W = W + 1:                  Arr(W, 1) = sRng.Address
        MsgBox sRng.Address
        Set sRng = Rng.FindNext(sRng)
    Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
 End If
 [E6].Resize(Rws).Value = Arr()
End Sub
 
Upvote 0
SA_DQ đã viết:
Bạn chạy thử con macro này xem thích không(?)
PHP: 
Sub TimKiemNhieuLan()
Dim J As Long, Rws As Long, W As Integer
Dim MyAdd As String, Tmp As String
Dim Rng As Range, sRng As Range, Arr() As String

Rws = Cells(Rows.Count, "C").End(xlUp).Row
Set Rng = Range([C1], Cells(Rws, "C"))
ReDim Arr(1 To Rws, 1 To 1)
[E6].Resize(Rws).ClearContents
Set sRng = Rng.Find([e4].Value, , xlFormulas, xlWhole)
If sRng Is Nothing Then
    MsgBox "Nothing!", , "GPE.COM Xin Thông Báo:"
Else
    MyAdd = sRng.Address
    Do
        W = W + 1:                  Arr(W, 1) = sRng.Address
        MsgBox sRng.Address
        Set sRng = Rng.FindNext(sRng)
    Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
End If
[E6].Resize(Rws).Value = Arr()
End Sub
Nhấp chuột vào đây để mở rộng...

Em cảm ơn bác. Nhưng chỉ muốn nó select vào ô thôi. không cần Hiện cái Thông báo địa chỉ đã tìm thấy làm gì bác ơi
Bài đã được tự động gộp:

CHAOQUAY đã viết:
Bạn chạy code dưới đây
Mã: 
Dim Mang, k

Sub timkiem()
Dim i As Long, j As Long, Tmp As String
If IsArray(Mang) = False Then
    ReDim Mang(1 To 5003)
    For i = 4 To 5003  ' so dong can tim 1 den 5000 dong
        Tmp = Range("C" & i).Value  ' cot C
        If UCase(Tmp) = UCase(Range("E4").Value) Then
            j = j + 1
            Mang(j) = i
        End If
    Next i
    If j Then ReDim Preserve Mang(1 To j)
End If
If Mang(1) = "" Then
    MsgBox "Khong tim thay"
Else
    k = k + 1
    j = (k - 1) Mod UBound(Mang) + 1
    i = Mang(j)
    Range("C" & i).Select
End If
End Sub
Nhấp chuột vào đây để mở rộng...

Em cảm ơn anh. Code chạy rất ok. Nhưng có điều sao em gõ tại ô Tìm kiếm tên không có trong mã hàng mà nó vấn tìm được . em thử thay ô tìm kiếm tại E4 ="GPE" thì có nghĩa là trong cột C đâu có từ nào có GPE đâu bác ạ. Tìm chính xác theo từ cần tìm kiếm luôn bác ơi. mong bác sửa lại giúp em
1584940253805.png
 
Lần chỉnh sửa cuối:
Upvote 0
congnguyen88 đã viết:
Em cảm ơn anh. Code chạy rất ok. Nhưng có điều sao em gõ tại ô Tìm kiếm tên không có trong mã hàng mà nó vấn tìm được . em thử thay ô tìm kiếm tại E4 ="GPE" thì có nghĩa là trong cột C đâu có từ nào có GPE đâu bác ạ. Tìm chính xác theo từ cần tìm kiếm luôn bác ơi. mong bác sửa lại giúp em
View attachment 233868
Nhấp chuột vào đây để mở rộng...
Bạn chạy thử file dưới đây
---
Trong file có sử dụng Worksheet_Change. Chuột phải vào tab sheet1, chọn view code sẽ thấy
 

File đính kèm

Upvote 0
CHAOQUAY đã viết:
Bạn chạy thử file dưới đây
---
Trong file có sử dụng Worksheet_Change. Chuột phải vào tab sheet1, chọn view code sẽ thấy
Nhấp chuột vào đây để mở rộng...

Mình có thử rồi. vẫn bị 1 lổi. Thí dụ mình đang tìm kiếm chử "M" ví dụ nó đang select tại ô C15 mà đổi sang chử "A" thì nó không select từ C4 xuống dưới mà nó quét từ C15 x
CHAOQUAY đã viết:
Bạn chạy thử file dưới đây
---
Trong file có sử dụng Worksheet_Change. Chuột phải vào tab sheet1, chọn view code sẽ thấy
Nhấp chuột vào đây để mở rộng...

Cảm ơn anh chị. em thấy code bị lổi rồi về thuật toán rồi. Ví dụ đang tìm kiếm chử "M" sau khi chạy code thì ví dụ select tại ô C15, rồi sau đó gõ lại chữ "A" để tìm kiếm thì nó không quét tìm kiếm từ C3 xuống mà nó lại quét từ C15 xuống. Và nhiều khi xóa trắng hết những ô có chử "A" nhập lại chử A vẫn thấy nó select những ô trống
 
Upvote 0
congnguyen88 đã viết:
Mình có thử rồi. vẫn bị 1 lổi. Thí dụ mình đang tìm kiếm chử "M" ví dụ nó đang select tại ô C15 mà đổi sang chử "A" thì nó không select từ C4 xuống dưới mà nó quét từ C15 x


Cảm ơn anh chị. em thấy code bị lổi rồi về thuật toán rồi. Ví dụ đang tìm kiếm chử "M" sau khi chạy code thì ví dụ select tại ô C15, rồi sau đó gõ lại chữ "A" để tìm kiếm thì nó không quét tìm kiếm từ C3 xuống mà nó lại quét từ C15 xuống. Và nhiều khi xóa trắng hết những ô có chử "A" nhập lại chử A vẫn thấy nó select những ô trống
Nhấp chuột vào đây để mở rộng...
Bạn gửi file lỗi lên cho cụ thể. file mẫu có chữ M nào đâu mà tìm
 
Upvote 0
Bài này dùng Find method thuận tiện hơn chứ sao lại dùng vòng lập vậy ta?
 
Upvote 0
CHAOQUAY đã viết:
Bạn gửi file lỗi lên cho cụ thể. file mẫu có chữ M nào đâu mà tìm
Nhấp chuột vào đây để mở rộng...
Gửi bạn
Bài đã được tự động gộp:

quanghai1969 đã viết:
Hãy record macro để biết cách làm. Đây là bài cơ bản thôi
Nhấp chuột vào đây để mở rộng...

Dạ sáng giờ em cũng reconrd macro mà không được anh ơi. Có 2 3 anh chị giúp mà code chạy chưa đúng nữa, Mong anh giúp đở. do em trình đồ còn sơ khai quá
 

File đính kèm

Upvote 0
Upvote 0
Upvote 0
@congnguyen88 :
Theo như yêu cầu của bạn thì chắc bài này còn nhiều điều kiện thay đổi khác nữa khi sử dụng nên có lẽ tôi dừng tại đây.
Bài đã được tự động gộp:

@phamvanphuc86
Chỉ chạy trong cột C nhé bạn, sang E4 là không đúng yêu cầu nhé bạn, phần in đậm đó
congnguyen88 đã viết:
* nếu trong cột C mã hàng không có mã tại ô E4 thì hiện thông báo Msbox("Mã hàng không tìm thay ")
* nêu trong cột C mã hàng có mã thì khi nhấn Find Next sẽ quét từ trên xuống dưới và Select lần lượt sau mổi lần click vào nút bấm Find next ( giống như Ctrl + F nhấn nút Find Next trong excel ) . Và khi kiếm tới mã của dòng cuối cùng nếu nhấn Find Next 1 lần nữa thì bắt đầu quét lại từ trên xuống dưới lại như ban đầu . Lưu ý tên mã hàng không phân biệt chữ hoa chử thường

Em xin cảm ơn các bạn, thầy cô giáo.
Nhấp chuột vào đây để mở rộng...
 
Lần chỉnh sửa cuối:
Upvote 0
cảm ơn bạn code của bạn chính xác theo ý mình rồi đó
Bài đã được tự động gộp:

CHAOQUAY đã viết:
@congnguyen88 :
Theo như yêu cầu của bạn thì chắc bài này còn nhiều điều kiện thay đổi khác nữa khi sử dụng nên có lẽ tôi dừng tại đây.
Bài đã được tự động gộp:

@phamvanphuc86
Chỉ chạy trong cột C nhé bạn, sang E4 là không đúng yêu cầu nhé bạn, phần in đậm đó
Nhấp chuột vào đây để mở rộng...
Code của bạn
phamvanphuc86
Chính xác rồi đó. Dù sao cũng cảm ơn bạn
 
Upvote 0
CHAOQUAY đã viết:
Hy vọng là khi sử dụng bạn sẽ không gặp rắc rối gì.
Thân chào!
Nhấp chuột vào đây để mở rộng...
dạ không sao anh. em có test trên file công ty code chạy rất ok anh ạ. Code anh cũng ok . Nhưng do chúng mình chắc chưa có duyên hay sao á. Em là con gái mong anh giúp đở
 
Upvote 0
congnguyen88 đã viết:
Em là con gái mong anh giúp đở
Nhấp chuột vào đây để mở rộng...
Trời, sao không nói từ đầu? Có một con át chủ bài mà không tung ra, rõ phí hoài.
---------
Bạn CHAOQUAY nói đúng. Bạn nhập E4 = a, rồi nhấn "Find Next". Sẽ có lúc bạn thấy E4 được chọn. Tức không đúng yêu cầu.
Bây giờ bạn tưởng tượng là trong tập tin thực ngoài cột C và E4 ra có 100 ô trên trang tính cũng có giá trị "a". Khi nhấn nút thì sẽ có lúc bạn phải nhấn 100 lần để ô được chọn trở về cột C. Bạn muốn thế? Mà thôi, bạn hài lòng là được rồi.
 
Lần chỉnh sửa cuối:
Upvote 0
Em là con gái (ảnh đại diện).

A_C.GIF
 
Lần chỉnh sửa cuối:
Upvote 0
batman1 đã viết:
Trời, sao không nói từ đầu? Có một con át chủ bài mà không tung ra, rõ phí hoài.
---------
Bạn CHAOQUAY nói đúng. Bạn nhập E4 = a, rồi nhấn "Find Next". Sẽ có lúc bạn thấy E4 được chọn. Tức không đúng yêu cầu.
Bây giờ bạn tưởng tượng là trong tập tin thực ngoài cột C và E4 ra có 100 ô trên trang tính cũng có giá trị "a". Khi nhấn nút thì sẽ có lúc bạn phải nhấn 100 lần để ô được chọn trở về cột C. Bạn muốn thế? Mà thôi, bạn hài lòng là được rồi.
Nhấp chuột vào đây để mở rộng...
dạ em thấy lổi rồi. có nghĩa là nó không quét trong cột C mà nó quét lung tung ở ngoài luôn. Mong thầy sửa lại giúp em
Bài đã được tự động gộp:

CHAOQUAY đã viết:
Hy vọng là khi sử dụng bạn sẽ không gặp rắc rối gì.
Thân chào!
Nhấp chuột vào đây để mở rộng...

dạ em thấy lổi rồi. có nghĩa là nó không quét trong cột C mà nó quét lung tung ở ngoài luôn. Mong anh sửa lại giúp em
 
Upvote 0
batman1 đã viết:
Trời, sao không nói từ đầu? Có một con át chủ bài mà không tung ra, rõ phí hoài.
---------
Bạn CHAOQUAY nói đúng. Bạn nhập E4 = a, rồi nhấn "Find Next". Sẽ có lúc bạn thấy E4 được chọn. Tức không đúng yêu cầu.
Bây giờ bạn tưởng tượng là trong tập tin thực ngoài cột C và E4 ra có 100 ô trên trang tính cũng có giá trị "a". Khi nhấn nút thì sẽ có lúc bạn phải nhấn 100 lần để ô được chọn trở về cột C. Bạn muốn thế? Mà thôi, bạn hài lòng là được rồi.
Nhấp chuột vào đây để mở rộng...

bác có thể giúp em làm sao xóa đoạn code thông báo địa chỉ. Em chỉ muốn nó Select trên bảng tính thôi

Mã: 
Sub usingFindNext()
Dim c As Range
On Error Resume Next
With Worksheets(1).Range("c4:c30")
    Set c = .Find(Range("e4"), LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
   firstAddress = c.Address
Do
 ' lam sao Bo Doan code Thong bao nay ra. Chi muon no Select thôi
  MsgBox "Value found in cell " & c.Address
  c.Select
  Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub
 
Upvote 0
congnguyen88 đã viết:
bác có thể giúp em làm sao xóa đoạn code thông báo địa chỉ. Em chỉ muốn nó Select trên bảng tính thôi

Mã: 
Sub usingFindNext()
Dim c As Range
On Error Resume Next
With Worksheets(1).Range("c4:c30")
    Set c = .Find(Range("e4"), LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
   firstAddress = c.Address
Do
' lam sao Bo Doan code Thong bao nay ra. Chi muon no Select thôi
  MsgBox "Value found in cell " & c.Address
  c.Select
  Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Nếu là tôi thì có lẽ thế này
Mã: 
Sub timkiem()
Dim rng As Range
    With ThisWorkbook.Worksheets("Sheet1")
        Set rng = .Range("C4:C5003")
        If Intersect(rng, ActiveCell) Is Nothing Or ActiveCell.Value <> .Range("E4").Value Then
            Set rng = rng.Find(.Range("E4").Value, .Range("C5003"), xlValues, xlNext)
        Else
            Set rng = rng.Find(.Range("E4").Value, ActiveCell, xlValues, xlNext)
        End If
    End With
    If Not rng Is Nothing Then rng.Select
End Sub
 
Upvote 0
"Hậu quả của việc đăng nhiều bài"

Làm tôi phải đăng bài trả lời hai bên nhưng bài viết tương tự nhau.

https://www.giaiphapexcel.com/diendan/threads/khắc-phục-sửa-đoạn-code-find-next.148474/#post-960259


----------------------
Dưới đây là phương thức Find Next của Excel được vận dụng trong VBA, chứ không phải phương thức tương tự.


----------------------
PHP: 
Sub FindNextXL()
  On Error Resume Next
  Static Area As Range, F As Range, Vl as Variant

  If F Is Nothing  Or Vl <> [E4].Value Then

    ''Tìm tất cả ô
    ''Set Area = Cells
    ''Tìm ở cột [C4:C100]
    Set Area = [C4:C100]
    Set F = Area.Find([E4].Value, , xlFormulas, xlWhole)
    Vl = [E4].Value
  Else
    Set F = Area.FindNext(F)
  End If
  F.Select
  On Error GoTo 0
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Dưới đây là một kỹ thuật Code để tận dụng Double Click để FindPrevious và Click sẽ là FindNext


-------------------------

PHP: 
#If VBA7 Then
Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End If

#If Win64 Then
  Public fSG_TimerID As LongPtr
#Else
  Public fSG_TimerID As Long
#End If
Public IsFindPrevious As Boolean
''--------------------------------------
Sub FindCall()
  On Error Resume Next
  Static EarliestTime As Date
  If EarliestTime + 0.13 > VBA.Timer Then
    IsFindPrevious = True
    EarliestTime = 0
  Else
    EarliestTime = VBA.Timer
    If fSG_TimerID <> 0 Then KillTimer 0&, fSG_TimerID
    fSG_TimerID = SetTimer(0&, 0&, 140, AddressOf FindXL)
  End If
End Sub

Private Sub FindXL()
  On Error Resume Next
  If fSG_TimerID <> 0 Then KillTimer 0&, fSG_TimerID
  Static Area As Range, F As Range, I As Long, Vl as Variant
  I = xlNext: If IsFindPrevious Then I = xlPrevious

  If F Is Nothing Or Vl <> [E4].Value Then
    ''All
    ''Set Area = Cells
    ''Only Column [C4:C100]
    Set Area = [C4:C100]
    Set F = Area.Find([E4].Value, , xlFormulas, xlWhole, , I)
    Vl = [E4].Value
  Else
    If IsFindPrevious Then
      Set F = Area.FindPrevious(F)
      IsFindPrevious = False
    Else
      Set F = Area.FindNext(F)
    End If
  End If
  If Not F Is Nothing Then F.Select
  On Error GoTo 0
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
batman1 đã viết:
Nếu là tôi thì có lẽ thế này
Mã: 
Sub timkiem()
Dim rng As Range
    With ThisWorkbook.Worksheets("Sheet1")
        Set rng = .Range("C4:C5003")
        If Intersect(rng, ActiveCell) Is Nothing Or ActiveCell.Value <> .Range("E4").Value Then
            Set rng = rng.Find(.Range("E4").Value, .Range("C5003"), xlValues, xlNext)
        Else
            Set rng = rng.Find(.Range("E4").Value, ActiveCell, xlValues, xlNext)
        End If
    End With
    If Not rng Is Nothing Then rng.Select
End Sub
Nhấp chuột vào đây để mở rộng...

Dạ code của thầy chạy chính xác ý em rồi ạ. Có điều em phải thêm UCase để không phân biệt chữ Hoa và Chữ Thường và tránh trường hợp gõ dấu * nó lại select sai.Em cảm ơn thầy rất nhiều
Mã: 
Sub timkiem()
Dim rng As Range, a As String
a = Range("E4").Value  ' du lieu can tim kiem
 
       Set rng = Range("C4:C5003") ' nguon can tim kiem
        If Intersect(rng, ActiveCell) Is Nothing Or UCase(ActiveCell.Value) <> UCase(a) Then
            Set rng = rng.Find(a, Range("C5003"), xlValues, xlNext)
        Else
            Set rng = rng.Find(a, ActiveCell, xlValues, xlNext)
        End If
 
    If Not rng Is Nothing And a <> "" And a <> "*" Then ' neu go dau * thi code Select sai vi tri
       rng.Select
    Else
       MsgBox ("khong tim thay")
    End If
  
End Sub
Bài đã được tự động gộp:

HeSanbi đã viết:
Dưới đây là một kỹ thuật Code để tận dụng Double Click để FindPrevious và Click sẽ là FindNext


-------------------------

PHP: 
#If VBA7 Then
Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End If

#If Win64 Then
  Public fSG_TimerID As LongPtr
#Else
  Public fSG_TimerID As Long
#End If
Public IsFindPrevious As Boolean
''--------------------------------------
Sub FindCall()
  On Error Resume Next
  Static EarliestTime As Date
  If EarliestTime + 0.13 > VBA.Timer Then
    IsFindPrevious = True
    EarliestTime = 0
  Else
    EarliestTime = VBA.Timer
    If fSG_TimerID <> 0 Then KillTimer 0&, fSG_TimerID
    fSG_TimerID = SetTimer(0&, 0&, 140, AddressOf FindXL)
  End If
End Sub

Private Sub FindXL()
  On Error Resume Next
  If fSG_TimerID <> 0 Then KillTimer 0&, fSG_TimerID
  Static Area As Range, F As Range, I As Long
  I = xlNext: If IsFindPrevious Then I = xlPrevious

  If F Is Nothing Then
    ''All
    ''Set Area = Cells
    ''Only Column [C4:C100]
    Set Area = [C4:C100]
    Set F = Area.Find([E4].Value, , xlFormulas, xlWhole, , I)
  Else
    If IsFindPrevious Then
      Set F = Area.FindPrevious(F)
      IsFindPrevious = False
    Else
      Set F = Area.FindNext(F)
    End If
  End If
  F.Select

  On Error GoTo 0
End Sub
Nhấp chuột vào đây để mở rộng...
Em cảm ơn anh rất nhiều. Code anh nhìn Pro quá
 
Lần chỉnh sửa cuối:
Upvote 0
congnguyen88 đã viết:
Em cảm ơn anh rất nhiều. Code anh nhìn Pro quá
Nhấp chuột vào đây để mở rộng...
-----------------------
Bên này tôi cũng đã sửa lại, bạn có thể copy lại.


Nếu muốn thêm dấu * mà không bị lỗi thì thêm hai dấu ngoặc vuông như thế này [*]

* mặc định sẽ là bất kì những kí tự nào.

Tìm google toán tử Like trong VBA sẽ biết được.
 
Upvote 0
congnguyen88 đã viết:
Dạ code của thầy chạy chính xác ý em rồi ạ. Có điều em phải thêm UCase để không phân biệt chữ Hoa và Chữ Thường và tránh trường hợp gõ dấu * nó lại select sai.Em cảm ơn thầy rất nhiều
Mã: 
Sub timkiem()
Dim rng As Range, a As String
a = Range("E4").Value  ' du lieu can tim kiem

       Set rng = Range("C4:C5003") ' nguon can tim kiem
        If Intersect(rng, ActiveCell) Is Nothing Or UCase(ActiveCell.Value) <> UCase(a) Then
            Set rng = rng.Find(a, Range("C5003"), xlValues, xlNext)
        Else
            Set rng = rng.Find(a, ActiveCell, xlValues, xlNext)
        End If

    If Not rng Is Nothing And a <> "" And a <> "*" Then ' neu go dau * thi code Select sai vi tri
       rng.Select
    Else
       MsgBox ("khong tim thay")
    End If
 
End Sub
Nhấp chuột vào đây để mở rộng...
Lỗi do bạn thôi. Cho đến bài #25 có thấy bạn nói gì về phân biệt chữ hoa chữ thường hay không phân biệt đâu. Về ký tự "*" cũng có thể mỗi người một ý muốn.
Nếu bạn không muốn phân biệt hoa thường, và muốn nhập "*" để tìm những ô có đúng 1 ký tự "*" ("*" có ý nghĩa là chính nó) thì
Mã: 
Sub timkiem()
Dim findValue As String, rng As Range
    With ThisWorkbook.Worksheets("Sheet1")
        findValue = .Range("E4").Value
        If findValue = "*" Then findValue = "~*"
        Set rng = .Range("C4:C5003")
        If Intersect(rng, ActiveCell) Is Nothing Or LCase(ActiveCell.Value) <> LCase(.Range("E4").Value) Then
            Set rng = rng.Find(findValue, .Range("C5003"), xlValues, xlNext)
        Else
            Set rng = rng.Find(findValue, ActiveCell, xlValues, xlNext)
        End If
    End With
    If Not rng Is Nothing Then rng.Select
End Sub
 
Upvote 0
HeSanbi đã viết:
Dưới đây là phương thức Find Next của Excel được vận dụng trong VBA, chứ không phải phương thức tương tự.
----------------------
PHP: 
Sub FindNextXL()
  On Error Resume Next
  Static Area As Range, F As Range, Vl as Variant

  If F Is Nothing  Or Vl <> [E4].Value Then

    ''Tìm tất cả ô
    ''Set Area = Cells
    ''Tìm ở cột [C4:C100]
    Set Area = [C4:C100]
    Set F = Area.Find([E4].Value, , xlFormulas, xlWhole)
    Vl = [E4].Value
  Else
    Set F = Area.FindNext(F)
  End If
  F.Select
  On Error GoTo 0
End Sub
Nhấp chuột vào đây để mở rộng...
Set F = Area.Find([E4].Value, , xlFormulas, xlWhole)
Nhấp chuột vào đây để mở rộng...

Đọc bài #1 tôi có cảm giác là thớt muốn tìm trong giá trị các ô. Nhưng người ta không nói rõ là các giá trị đó trong thực tế lấy từ đâu. Có thể nhập tay, cũng có thể do công thức trả về. Trong trường hợp không rõ ràng như thế thì người khôn ngoan sẽ dùng xlValues để đảm bảo an toàn. Nhất là khi người ta chỉ muốn tìm trong các "GIÁ TRỊ CỦA Ô". Dùng xlFormulas mà trong thực tế của người ta các dữ liệu tại cột C là do công thức trả về thì "méo mặt". Tự dưng lại làm khó mình, tự dưng lại đặt mình vào trạng thái thụ động, tự dưng lại phải cầu mong sự may rủi, tự dưng chấp nhận phụ thuộc vào cách thức có được dữ liệu trong cột C. Trong khi có thể dùng xlValues.
Ai còn chưa hiểu tôi nói gì thì nhập công thức vào C4
Mã: 
=E4

Cho dù nhập gì vào E4 thì code không bao giờ trả về - chọn C4.
 
Upvote 0
@congnguyen88

Thêm một kĩ thuật code khác
-----------------------------

PHP: 
Option Explicit

#If VBA7 Then
Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End If

#If Win64 Then
  Private Pri_TimerID As LongPtr
#Else
  Private Pri_TimerID As Long
#End If
Private FindArea As Range, RngPrevious As Range, RngNext As Range
Private TimeoutTerminate As Date
'--------------------------------------
'MainSub
Sub FindCall()
  On Error Resume Next
  Application.OnTime TimeoutTerminate, "'" & ThisWorkbook.Name & "'!FindXL_Terminate", , False
  Static EarliestTime As Date
  If EarliestTime + 0.13 > VBA.Timer Then
    EarliestTime = 0
    Set RngNext = RngPrevious
  Else
    EarliestTime = VBA.Timer
    If Pri_TimerID <> 0 Then KillTimer 0&, Pri_TimerID
    Application.OnTime VBA.Now, "'" & ThisWorkbook.Name & "'!FindXL_Early"
    Pri_TimerID = SetTimer(0&, 0&, 140, AddressOf FindXL)
  End If
  TimeoutTerminate = VBA.Now + VBA.TimeSerial(0, 0, 60)
  Application.OnTime TimeoutTerminate, "'" & ThisWorkbook.Name & "'!FindXL_Terminate"
End Sub
Private Sub FindXL()
  On Error Resume Next
  If Pri_TimerID <> 0 Then KillTimer 0&, Pri_TimerID
  RngNext.Select
  On Error GoTo 0
End Sub

Sub FindXL_Early()
  On Error Resume Next
  Static Vl As Variant
  Dim B As Boolean, vVl As Variant
  B = RngNext.Address <> Selection.Address
  vVl = [E4].Value
  If FindArea Is Nothing Or B Or Vl <> vVl Then
    'All
    'Set FindArea = Cells
    'Only Column [C4:C100]
    Set FindArea = [C4:C100]
    Set RngPrevious = FindArea.Find(vVl, , xlValues, xlWhole, searchdirection:=xlPrevious)
    Set RngNext = FindArea.Find(vVl, , xlValues, xlWhole, searchdirection:=xlNext)
    Vl = vVl
  Else
    Set RngPrevious = FindArea.FindPrevious(RngNext)
    Set RngNext = FindArea.FindNext(RngNext)
  End If
  On Error GoTo 0
End Sub
Sub FindXL_Terminate()
  Set FindArea = Nothing
  Set RngPrevious = Nothing
  Set RngNext = Nothing
End Sub
 
Upvote 0
batman1 đã viết:
Lỗi do bạn thôi. Cho đến bài #25 có thấy bạn nói gì về phân biệt chữ hoa chữ thường hay không phân biệt đâu. Về ký tự "*" cũng có thể mỗi người một ý muốn.
Nếu bạn không muốn phân biệt hoa thường, và muốn nhập "*" để tìm những ô có đúng 1 ký tự "*" ("*" có ý nghĩa là chính nó) thì
Mã: 
Sub timkiem()
Dim findValue As String, rng As Range
    With ThisWorkbook.Worksheets("Sheet1")
        findValue = .Range("E4").Value
        If findValue = "*" Then findValue = "~*"
        Set rng = .Range("C4:C5003")
        If Intersect(rng, ActiveCell) Is Nothing Or LCase(ActiveCell.Value) <> LCase(.Range("E4").Value) Then
            Set rng = rng.Find(findValue, .Range("C5003"), xlValues, xlNext)
        Else
            Set rng = rng.Find(findValue, ActiveCell, xlValues, xlNext)
        End If
    End With
    If Not rng Is Nothing Then rng.Select
End Sub
Nhấp chuột vào đây để mở rộng...

1585126015821.png
Code của thầy chạy rất ok rồi ạ
Bài đã được tự động gộp:

HeSanbi đã viết:
@congnguyen88

Thêm một kĩ thuật code khác
-----------------------------

PHP: 
Option Explicit

#If VBA7 Then
Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End If

#If Win64 Then
  Private Pri_TimerID As LongPtr
#Else
  Private Pri_TimerID As Long
#End If
Private FindArea As Range, RngPrevious As Range, RngNext As Range
Private TimeoutTerminate As Date
'--------------------------------------
'MainSub
Sub FindCall()
  On Error Resume Next
  Application.OnTime TimeoutTerminate, "'" & ThisWorkbook.Name & "'!FindXL_Terminate", , False
  Static EarliestTime As Date
  If EarliestTime + 0.13 > VBA.Timer Then
    EarliestTime = 0
    Set RngNext = RngPrevious
  Else
    EarliestTime = VBA.Timer
    If Pri_TimerID <> 0 Then KillTimer 0&, Pri_TimerID
    Application.OnTime VBA.Now, "'" & ThisWorkbook.Name & "'!FindXL_Early"
    Pri_TimerID = SetTimer(0&, 0&, 140, AddressOf FindXL)
  End If
  TimeoutTerminate = VBA.Now + VBA.TimeSerial(0, 0, 60)
  Application.OnTime TimeoutTerminate, "'" & ThisWorkbook.Name & "'!FindXL_Terminate"
End Sub
Private Sub FindXL()
  On Error Resume Next
  If Pri_TimerID <> 0 Then KillTimer 0&, Pri_TimerID
  RngNext.Select
  On Error GoTo 0
End Sub

Sub FindXL_Early()
  On Error Resume Next
  Static Vl As Variant
  Dim B As Boolean, vVl As Variant
  B = RngNext.Address <> Selection.Address
  vVl = [E4].Value
  If FindArea Is Nothing Or B Or Vl <> vVl Then
    'All
    'Set FindArea = Cells
    'Only Column [C4:C100]
    Set FindArea = [C4:C100]
    Set RngPrevious = FindArea.Find(vVl, , xlValues, xlWhole, searchdirection:=xlPrevious)
    Set RngNext = FindArea.Find(vVl, , xlValues, xlWhole, searchdirection:=xlNext)
    Vl = vVl
  Else
    Set RngPrevious = FindArea.FindPrevious(RngNext)
    Set RngNext = FindArea.FindNext(RngNext)
  End If
  On Error GoTo 0
End Sub
Sub FindXL_Terminate()
  Set FindArea = Nothing
  Set RngPrevious = Nothing
  Set RngNext = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...

Đã thư hết code. nhưng sao không chạy được ạ
 
Upvote 0
congnguyen88 đã viết:
Đã thư hết code. nhưng sao không chạy được ạ
Nhấp chuột vào đây để mở rộng...
------------------------


Gán duy nhất Thủ tục FindCall vào Shape, các thủ tục khác là để bổ trợ mà thôi.

Chỉ cần thay đổi ở những dòng code sau nếu chuyển Vùng và giá trị:
vVl = [E4].Value
Set FindArea = [C4:C100]

Còn nếu Code không ổn định thì bạn có thể dựa vào code của một số thành viên khác.
 
Upvote 0
congnguyen88 đã viết:
Mình có 1 file của công ty gồm nhiều mã hàng trùng nhau. Mình có viết 1 đoạn code để tìm ( giống như Ctrl + F nhấn nút Find Next trong excel ). mà code mình chỉ tìm thấy 1 tên đầu tiên và dừng lại không chạy tiếp. Cho mình hỏi sửa lại code chổ nào để Find Next những mã tiếp theo
* nếu trong cột C mã hàng không có mã tại ô E4 thì hiện thông báo Msbox("Mã hàng không tìm thay ")
* nêu trong cột C mã hàng có mã thì khi nhấn Find Next sẽ quét từ trên xuống dưới và Select lần lượt sau mổi lần click vào nút bấm Find next ( giống như Ctrl + F nhấn nút Find Next trong excel ) . Và khi kiếm tới mã của dòng cuối cùng nếu nhấn Find Next 1 lần nữa thì bắt đầu quét lại từ trên xuống dưới lại như ban đầu . Lưu ý tên mã hàng không phân biệt chữ hoa chử thường

Em xin cảm ơn các bạn, thầy cô giáo.
Mã: 
Sub timkiem()

On Error Resume Next
Dim i As Long, Tmp As String
For i = 4 To 5003  ' so dong can tim 1 den 5000 dong
    Tmp = Range("C" & i).Value  ' cot C
    If UCase(Tmp) = UCase(Range("E4").Value) Then
        Cells(i, 3).Select
    Else
       MsgBox ("Khong tim thay ma")
       Exit For
    End If
Next i

End Sub

View attachment 233861
Nhấp chuột vào đây để mở rộng...
Xin chào các thành viên, cho mình mượn nội dung của bạn congnguyen88 , nhưng mình không muốn nhập mã tại cột E4, mà mình muốn khi chọn Find Next thì sẽ dò tìm trên cột C đó luôn, đưa ra msgbox là " Count mã trùng nhau lặp lại+ tên mã trùng nhau", rồi mình chọn Ok ,( mục đích là mình kiếm mã trùng nhau để gom lại một chỗ, cái này sẽ làm thao tác tay),xong lại muốn tìm mã nào khác trùng nhau nữa thì minh lại bấm Find Next. Cám ơn các thanh viên.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

N
Nhờ giúp Drop down list theo tỉnh xã mới.
Trả lời
4
Đọc
101
SA_DQ
SA_DQ
V
Quản lý xuất nhập vật tư trong kho (1 người xem)
Trả lời
12
Đọc
417
Vũ Hải Sơn
V
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
3 4 5
Trả lời
427
Đọc
56K
ongke0711
ongke0711
H
  • Question Question
Dò tìm giá trị từ bảng khác theo cột
Trả lời
6
Đọc
260
Chả_biết_gì
C
2
  • Question Question
Hỏi cách in phiếu điều tra PCGD-XMC từ file dữ liệu mẫu xuất ra từ hệ thống PCGD-XMC của Bộ GD
    • Thích
Trả lời
26
Đọc
1K
haitien123
H
ongke0711
Truy cập trang GPE chậm
    • Thích
Trả lời
3
Đọc
143
Hai Lúa Miền Tây
Hai Lúa Miền Tây
N
Định mức nguyên vật liệu
Trả lời
48
Đọc
5K
ptm0412
ptm0412
V
Gộp File Từng File Excel vào 1 File
Trả lời
16
Đọc
400
ptm0412
ptm0412
Gà Con yêu VBA
Mở Pass file excel phiên bản .xlsx , xlsm, xlsb
Trả lời
10
Đọc
728
Zizi One
Zizi One
I
Phân bổ số lượng xuất kho trong kỳ theo từng mã nguyên vật liệu
Trả lời
6
Đọc
168
IrisQ
I
L
Các bạn giúp mình hoàn thiện công thức hàm sumif nhé
Trả lời
5
Đọc
135
lequang_qn
L
N
Xin file tính khẩu phần ăn cho trường mầm non
Trả lời
5
Đọc
6K
HUONGHCKT
H
Gà Công Nghệ
Cập nhật dữ liệu từ sheet này sang sheet khác
Trả lời
14
Đọc
274
HUONGHCKT
H
queluatb
Tự động tăng số hóa đơn theo điều kiện
Trả lời
4
Đọc
166
queluatb
queluatb
HeSanbi
  • Đã giải quyết
VBA_FastCode v2.22 - Công cụ học và viết mã VBA một cách nhanh nhất (*27/10/2023) (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
53
Đọc
18K
sutu
S
hung2412
Nhờ giúp Lấy sao kê giao dịch từ Trang Web BIDV bằng VBA (1 người xem)
Trả lời
6
Đọc
265
ongke0711
ongke0711
N
Tạo COM Add-In bằng Visual C++ (1 người xem)
    • Thích
Trả lời
15
Đọc
1K
Tuanba1992
Tuanba1992
T
Kính nhờ Anh chị hỗ trợ giúp e công thức giúp e với ạ!
Trả lời
3
Đọc
93
IrisQ
I
L
Hàm nối ký tự trong 1 cell khi trong cell các ký tự xuống dòng
Trả lời
2
Đọc
132
HieuCD
H
J
Xử lý các file Excel bị nặng sau nhiều năm sử dụng
Trả lời
19
Đọc
2K
Hà Tiềm
H
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

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

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom