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

Liên hệ QC
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
356
Đượ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

  • timkiemxx.xlsb
    15.9 KB · Đọc: 11
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

  • Copy of timkiemxx.xlsb
    18.7 KB · Đọc: 25
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

  • Copy of timkiemxxxxxx.xlsb
    18.2 KB · Đọc: 7
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
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

Thuthao1002
Tính thưởng khi doanh thu thực tế lớn hơn doanh thu chỉ tiêu dựa vào mức thưởng quy định
Trả lời
4
Đọc
35
bebo021999
B
P
TÔ MÀU THEO ĐIỀU KIỆN HÀNG GHI NGÀY ĐẦU TIÊN
Trả lời
1
Đọc
42
bebo021999
B
72G1
TÌM VÀ TẠO FILE .
Trả lời
1
Đọc
35
Hoàng Tuấn 868
H
emlat3
Đặt màu xen kẽ các dòng theo ký tự
Trả lời
11
Đọc
201
emlat3
emlat3
Emyeuexcel
  • Question
VBA lưu file, in, và mở lại file gốc ban đầu
Trả lời
0
Đọc
37
Emyeuexcel
Emyeuexcel
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom