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

congnguyen88 · 23/3/20

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

congnguyen88 · 23/3/20

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!

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 đở

batman1 · 24/3/20

congnguyen88 đã viết:
Em là con gái mong anh giúp đở

Trời, sao không nói từ đầu? Có một con át chủ bài mà không tung ra, rõ phí hoài.
---------
Bạn CHAOQUAY nói đúng. Bạn nhập E4 = a, rồi nhấn "Find Next". Sẽ có lúc bạn thấy E4 được chọn. Tức không đúng yêu cầu.
Bây giờ bạn tưởng tượng là trong tập tin thực ngoài cột C và E4 ra có 100 ô trên trang tính cũng có giá trị "a". Khi nhấn nút thì sẽ có lúc bạn phải nhấn 100 lần để ô được chọn trở về cột C. Bạn muốn thế? Mà thôi, bạn hài lòng là được rồi.

be_09 · 24/3/20

Em là con gái (ảnh đại diện).

congnguyen88 · 24/3/20

batman1 đã viết:
Trời, sao không nói từ đầu? Có một con át chủ bài mà không tung ra, rõ phí hoài.
---------
Bạn CHAOQUAY nói đúng. Bạn nhập E4 = a, rồi nhấn "Find Next". Sẽ có lúc bạn thấy E4 được chọn. Tức không đúng yêu cầu.
Bây giờ bạn tưởng tượng là trong tập tin thực ngoài cột C và E4 ra có 100 ô trên trang tính cũng có giá trị "a". Khi nhấn nút thì sẽ có lúc bạn phải nhấn 100 lần để ô được chọn trở về cột C. Bạn muốn thế? Mà thôi, bạn hài lòng là được rồi.

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: 24/3/20

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!

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

congnguyen88 · 24/3/20

batman1 đã viết:
Trời, sao không nói từ đầu? Có một con át chủ bài mà không tung ra, rõ phí hoài.
---------
Bạn CHAOQUAY nói đúng. Bạn nhập E4 = a, rồi nhấn "Find Next". Sẽ có lúc bạn thấy E4 được chọn. Tức không đúng yêu cầu.
Bây giờ bạn tưởng tượng là trong tập tin thực ngoài cột C và E4 ra có 100 ô trên trang tính cũng có giá trị "a". Khi nhấn nút thì sẽ có lúc bạn phải nhấn 100 lần để ô được chọn trở về cột C. Bạn muốn thế? Mà thôi, bạn hài lòng là được rồi.

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

batman1 · 24/3/20

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

Nếu là tôi thì có lẽ thế nà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

HeSanbi · 24/3/20

"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

HeSanbi · 24/3/20

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

congnguyen88 · 24/3/20

batman1 đã viết:

Nếu là tôi thì có lẽ thế nà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

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: 24/3/20

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

Em cảm ơn anh rất nhiều. Code anh nhìn Pro quá

HeSanbi · 24/3/20

congnguyen88 đã viết:
Em cảm ơn anh rất nhiều. Code anh nhìn Pro quá

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

batman1 · 25/3/20

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

Lỗi do bạn thôi. Cho đến bài #25 có thấy bạn nói gì về phân biệt chữ hoa chữ thường hay không phân biệt đâu. Về ký tự "*" cũng có thể mỗi người một ý muốn.
Nếu bạn không muốn phân biệt hoa thường, và muốn nhập "*" để tìm những ô có đúng 1 ký tự "*" ("*" có ý nghĩa là chính nó) thì

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

batman1 · 25/3/20

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

Set F = Area.Find([E4].Value, , xlFormulas, xlWhole)

Đọc bài #1 tôi có cảm giác là thớt muốn tìm trong giá trị các ô. Nhưng người ta không nói rõ là các giá trị đó trong thực tế lấy từ đâu. Có thể nhập tay, cũng có thể do công thức trả về. Trong trường hợp không rõ ràng như thế thì người khôn ngoan sẽ dùng xlValues để đảm bảo an toàn. Nhất là khi người ta chỉ muốn tìm trong các "GIÁ TRỊ CỦA Ô". Dùng xlFormulas mà trong thực tế của người ta các dữ liệu tại cột C là do công thức trả về thì "méo mặt". Tự dưng lại làm khó mình, tự dưng lại đặt mình vào trạng thái thụ động, tự dưng lại phải cầu mong sự may rủi, tự dưng chấp nhận phụ thuộc vào cách thức có được dữ liệu trong cột C. Trong khi có thể dùng xlValues.
Ai còn chưa hiểu tôi nói gì thì nhập công thức vào C4

Mã:

=E4

Cho dù nhập gì vào E4 thì code không bao giờ trả về - chọn C4.

HeSanbi · 25/3/20

@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

congnguyen88 · 25/3/20

batman1 đã viết:
Lỗi do bạn thôi. Cho đến bài #25 có thấy bạn nói gì về phân biệt chữ hoa chữ thường hay không phân biệt đâu. Về ký tự "*" cũng có thể mỗi người một ý muốn.
Nếu bạn không muốn phân biệt hoa thường, và muốn nhập "*" để tìm những ô có đúng 1 ký tự "*" ("*" có ý nghĩa là chính nó) thì

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

Code của thầy chạy rất ok rồi ạ

Bài đã được tự động gộp: 25/3/20

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

Đã thư hết code. nhưng sao không chạy được ạ

HeSanbi · 25/3/20

congnguyen88 đã viết:
Đã thư hết code. nhưng sao không chạy được ạ

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

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.

truongvu317 · 25/3/20

batman1 đã viết:
Có một con át chủ bài mà không tung ra, rõ phí hoài.

Bác nói chuyện vui thiệt! tung át chủ bải ra để "lốc out" hêt á. Cháu có hẳn dăm ba con chủ bài mà có dám dùng đâu.

longkurabe · 25/3/20

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

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.

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

Thành viên bị đình chỉ hoạt động

File đính kèm

Thành viên bị đình chỉ hoạt động

Thành viên gạo cội

Biên Hòa, Đồng Nai

Thành viên bị đình chỉ hoạt động

Thành viên bị đình chỉ hoạt động

Thành viên gạo cội

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Thành viên bị đình chỉ hoạt động

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Thành viên gạo cội

Thành viên gạo cội

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Thành viên bị đình chỉ hoạt động

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

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

Thành viên mới

Facebook

Group