Macro tìm kiếm với nội dung tại ô con chuột đang chỉ (1 người xem)

[Tnhatanh68]

Chào mọi người,

Mình đang làm excel và có một vấn đề muốn mọi người giúp đỡ như sau.

Mình đính kèm lên 1 file trong đó có 4 sheet:

- Sheet 1: FPL EXPORT
- Sheet 2: LICH MUA
- Sheet 3: BO SUNG
- Sheet 4: RESULT

Vấn đề mình muốn nhờ mọi người là ví dụ trong Sheet 1, khi con chuột nằm ở cell A1 (có nội dung "BL790") hoặc bất kì một cell nào đó thì khi mình chạy hàm Macro, hàm sẽ tự động tìm kiếm nội dung cell này trong Sheet "BO SUNG" đầu tiên, nếu không tìm thấy sẽ Tìm tiếp trong Sheet "LICH MUA" .

Ví dụ: khi macro chạy với ví dụ như trên (nội dung BL790) thì kết quả sẽ ra như sau (kết quả tìm trong sheet BO SUNG):

[TABLE="width: 384"]
[TR]
[TD="width: 64"]BL790[/TD]
[TD="width: 64, align: right"]2[/TD]
[TD="width: 64, align: right"]5[/TD]
[TD="width: 64, align: right"]6[/TD]
[TD="width: 64, align: right"]8[/TD]
[TD="width: 64, align: right"]9[/TD]
[/TR]
[TR]
[TD]BL790[/TD]
[TD="align: right"]8[/TD]
[TD="align: right"]9[/TD]
[TD="align: right"]10[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]15[/TD]
[/TR]
[TR]
[TD]BL790[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]7[/TD]
[TD="align: right"]9[/TD]
[/TR]
[/TABLE]

Kết quả dữ liệu được tìm kiếm này sẽ được thể hiện ra từ cell A1 Sheet RESULT.

Cảm ơn mọi người đã dành thời gian ngó qua.

Cảm ơn.

 

[nghiaphuc]

Chào mọi người,

Mình đang làm excel và có một vấn đề muốn mọi người giúp đỡ như sau.

Mình đính kèm lên 1 file trong đó có 4 sheet:

- Sheet 1: FPL EXPORT
- Sheet 2: LICH MUA
- Sheet 3: BO SUNG
- Sheet 4: RESULT

Vấn đề mình muốn nhờ mọi người là ví dụ trong Sheet 1, khi con chuột nằm ở cell A1 (có nội dung "BL790") hoặc bất kì một cell nào đó thì khi mình chạy hàm Macro, hàm sẽ tự động tìm kiếm nội dung cell này trong Sheet "BO SUNG" đầu tiên, nếu không tìm thấy sẽ Tìm tiếp trong Sheet "LICH MUA" .

Ví dụ: khi macro chạy với ví dụ như trên (nội dung BL790) thì kết quả sẽ ra như sau (kết quả tìm trong sheet BO SUNG):

[TABLE="width: 384"]
[TR]
[TD="width: 64"]BL790[/TD]
[TD="width: 64, align: right"]2[/TD]
[TD="width: 64, align: right"]5[/TD]
[TD="width: 64, align: right"]6[/TD]
[TD="width: 64, align: right"]8[/TD]
[TD="width: 64, align: right"]9[/TD]
[/TR]
[TR]
[TD]BL790[/TD]
[TD="align: right"]8[/TD]
[TD="align: right"]9[/TD]
[TD="align: right"]10[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"]15[/TD]
[/TR]
[TR]
[TD]BL790[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]7[/TD]
[TD="align: right"]9[/TD]
[/TR]
[/TABLE]

Kết quả dữ liệu được tìm kiếm này sẽ được thể hiện ra từ cell A1 Sheet RESULT.

Cảm ơn mọi người đã dành thời gian ngó qua.

Cảm ơn.

Code hơi rườm rà chút xíu, bạn thử nhé:
[GPECODE=vb]Sub mSearch()
Dim Ws As Worksheet, S As String, fAdd As String, Cll As Range, k As Long, i As Long, Arr()
Sheets("RESULT").Cells.Clear
If IsEmpty(ActiveCell) Then Exit Sub
S = ActiveCell.Value
ReDim Arr(1 To 100, 1 To 6)
On Error Resume Next
Set Ws = Sheets("BO SUNG")
Set Cll = Ws.[A:A].Find(S, Ws.[A1], xlValues, xlWhole)
If Cll Is Nothing Then
Set Ws = Sheets("LICH MUA")
Set Cll = Ws.[A:A].Find(S, Ws.[A1], xlValues, xlWhole)
End If
fAdd = Cll.Address
If fAdd = "" Then Exit Sub
Do
k = k + 1
For i = 1 To 6
Arr(k, i) = Cll.Offset(, i - 1)
Next
Set Cll = Ws.[A:A].FindNext(Cll)
Loop Until Cll.Address = fAdd
Sheets("RESULT").[A1].Resize(k, 6) = Arr
End Sub[/GPECODE]

 

[Tnhatanh68]

Cảm ơn bạn cực kì nhiều, macro chạy rất ổn.

Nhưng bạn có thể giúp mình thêm một vấn đề như thế này không, dữ liệu trong sheet FPL EXPORT bây giờ có dạng như thế này

BL782/BL783 VN4232/VN4233 320.VNA560
BL265/BL266 VN4113/VN4112 320.VNA560
BL326/BL327 VN4160/VN4161 320.VNA560
BL256 320.VNA560 SGN-PXU-SGN


Khi chuột nằm ở cell đầu ( có giá trị như sau: BL782/BL783 VN4232/VN4233 320.VNA560 ) thì hàm sẽ tự động tìm kiếm như trên với 2 giá trị là BL782 và BL783 rồi trả ra giá trị tìm kiếm với 2 nội dung trên

Nếu cell chỉ có giá trị "BL256 320.VNA560 SGN-PXU-SGN " tức là chỉ tìm kiếm 1 giá trị là BL256.

Sau đó nó sẽ hiện thêm Msgbox ra màn hình kết quả tìm kiếm những giá trị này được không bạn

Cảm ơn bạn rất rất nhiều.

 

[nghiaphuc]

Cảm ơn bạn cực kì nhiều, macro chạy rất ổn.

Nhưng bạn có thể giúp mình thêm một vấn đề như thế này không, dữ liệu trong sheet FPL EXPORT bây giờ có dạng như thế này

BL782/BL783 VN4232/VN4233 320.VNA560
BL265/BL266 VN4113/VN4112 320.VNA560
BL326/BL327 VN4160/VN4161 320.VNA560
BL256 320.VNA560 SGN-PXU-SGN
.............................................

Hỏi lại bạn một chút cho chắc: Có phải các mã đều có dạng BL000 (2 chữ và 3 số) như vậy không hay còn có dạng khác nữa? Nếu mã luôn có dạng như vậy thì có thể xử lý được.
Ngoài ra, trên thực tế có dòng nào có 3 mã trở lên không hay chỉ 1 hoặc 2 mã thôi?

Tôi chờ câu trả lời của bạn rồi nghiên cứu luôn chứ không thì lại mất công vô ích.

 

[Tnhatanh68]

Hỏi lại bạn một chút cho chắc: Có phải các mã đều có dạng BL000 (2 chữ và 3 số) như vậy không hay còn có dạng khác nữa? Nếu mã luôn có dạng như vậy thì có thể xử lý được.
Ngoài ra, trên thực tế có dòng nào có 3 mã trở lên không hay chỉ 1 hoặc 2 mã thôi?

Tôi chờ câu trả lời của bạn rồi nghiên cứu luôn chứ không thì lại mất công vô ích.

Chỉ có 1 hoặc 2 mã thôi bạn
Luôn có dạng BLxxxx, 2 chữ BL luôn có định, số thì có thể 3 hoặc 4 chữ số (ví dụ BL520, BL3369,...) ngoài ra không có dạng khác. Nếu 2 mã đi chung với nhau trên 1 dòng thì luôn có dấu "/" để phân cách, sau các mã luôn là khoảng trống. Nếu chỉ có 1 mã 1 dòng thì không có dấu "/" và sau đó sẽ là khoảng trống rồi mới đến những nội dung sau

Cảm ơn bạn nhiều.

 

[nghiaphuc]

Chỉ có 1 hoặc 2 mã thôi bạn
Luôn có dạng BLxxxx, 2 chữ BL luôn có định, số thì có thể 3 hoặc 4 chữ số (ví dụ BL520, BL3369,...) ngoài ra không có dạng khác. Nếu 2 mã đi chung với nhau trên 1 dòng thì luôn có dấu "/" để phân cách, sau các mã luôn là khoảng trống. Nếu chỉ có 1 mã 1 dòng thì không có dấu "/" và sau đó sẽ là khoảng trống rồi mới đến những nội dung sau

Cảm ơn bạn nhiều.

Tôi dùng 2 thủ tục như sau:
[GPECODE=vb]Sub mSearch()
Dim S As String, Res As String
Sheets("RESULT").Cells.Clear
Res = "Ket qua tim kiem:"
If IsEmpty(ActiveCell) Then Exit Sub
S = Left(ActiveCell.Value, InStr(1, ActiveCell.Value, " ") - 1)
If InStr(1, S, "/") > 0 Then
MySearch Left(S, InStr(1, S, "/") - 1), Res
MySearch Mid(S, InStr(1, S, "/") + 1, Len(S)), Res
Else
MySearch S, Res
End If
Sheets("RESULT").[1:1].Delete
MsgBox Res
End Sub[/GPECODE]
[GPECODE=vb]Sub MySearch(S As String, Res As String)
Dim Ws As Worksheet, fAdd As String, Cll As Range, k As Long, i As Long, Arr()
ReDim Arr(1 To 100, 1 To 6)
On Error Resume Next
Set Ws = Sheets("BO SUNG")
Set Cll = Ws.[A:A].Find(S, Ws.[A1], xlValues, xlWhole)
If Cll Is Nothing Then
Set Ws = Sheets("LICH MUA")
Set Cll = Ws.[A:A].Find(S, Ws.[A1], xlValues, xlWhole)
End If
fAdd = Cll.Address
If fAdd = "" Then Exit Sub
Do
k = k + 1
Res = Res & Chr(10)
For i = 1 To 6
Arr(k, i) = Cll.Offset(, i - 1)
Res = Res & Arr(k, i) & " | "
Next
Set Cll = Ws.[A:A].FindNext(Cll)
Loop Until Cll.Address = fAdd
Sheets("RESULT").[A1000].End(xlUp).Offset(1).Resize(k, 6) = Arr
End Sub[/GPECODE]
Trong 2 thủ tục trên, câu lệnh nào có đụng tới biến Res đều nhằm mục đích phục vụ cho việc xuất kết quả trên Msgbox, nếu không cần thì bạn có thể bỏ chúng đi. Tôi nghĩ việc hiển thị kết quả trên Msgbox chỉ phù hợp cho trường hợp có ít kết quả thỏa mãn, chứ nếu nhiều thì có vẻ không ổn.

 

[Tnhatanh68]

Tôi dùng 2 thủ tục như sau:
[GPECODE=vb]Sub mSearch()
Dim S As String, Res As String
Sheets("RESULT").Cells.Clear
Res = "Ket qua tim kiem:"
If IsEmpty(ActiveCell) Then Exit Sub
S = Left(ActiveCell.Value, InStr(1, ActiveCell.Value, " ") - 1)
If InStr(1, S, "/") > 0 Then
MySearch Left(S, InStr(1, S, "/") - 1), Res
MySearch Mid(S, InStr(1, S, "/") + 1, Len(S)), Res
Else
MySearch S, Res
End If
Sheets("RESULT").[1:1].Delete
MsgBox Res
End Sub[/GPECODE]
[GPECODE=vb]Sub MySearch(S As String, Res As String)
Dim Ws As Worksheet, fAdd As String, Cll As Range, k As Long, i As Long, Arr()
ReDim Arr(1 To 100, 1 To 6)
On Error Resume Next
Set Ws = Sheets("BO SUNG")
Set Cll = Ws.[A:A].Find(S, Ws.[A1], xlValues, xlWhole)
If Cll Is Nothing Then
Set Ws = Sheets("LICH MUA")
Set Cll = Ws.[A:A].Find(S, Ws.[A1], xlValues, xlWhole)
End If
fAdd = Cll.Address
If fAdd = "" Then Exit Sub
Do
k = k + 1
Res = Res & Chr(10)
For i = 1 To 6
Arr(k, i) = Cll.Offset(, i - 1)
Res = Res & Arr(k, i) & " | "
Next
Set Cll = Ws.[A:A].FindNext(Cll)
Loop Until Cll.Address = fAdd
Sheets("RESULT").[A1000].End(xlUp).Offset(1).Resize(k, 6) = Arr
End Sub[/GPECODE]
Trong 2 thủ tục trên, câu lệnh nào có đụng tới biến Res đều nhằm mục đích phục vụ cho việc xuất kết quả trên Msgbox, nếu không cần thì bạn có thể bỏ chúng đi. Tôi nghĩ việc hiển thị kết quả trên Msgbox chỉ phù hợp cho trường hợp có ít kết quả thỏa mãn, chứ nếu nhiều thì có vẻ không ổn.

Mình cảm ơn rất nhiều, lí do mình muốn xuất ra là để so sánh với các kết quả, đúng là nếu nhiều sẽ bất tiện thật. Mình đang vừa học vừa thực hành nên muốn học tập ở các bạn rất nhiều.

 

[Tnhatanh68]

Code hơi rườm rà chút xíu, bạn thử nhé:
[GPECODE=vb]Sub mSearch()
Dim Ws As Worksheet, S As String, fAdd As String, Cll As Range, k As Long, i As Long, Arr()
Sheets("RESULT").Cells.Clear
If IsEmpty(ActiveCell) Then Exit Sub
S = ActiveCell.Value
ReDim Arr(1 To 100, 1 To 6)
On Error Resume Next
Set Ws = Sheets("BO SUNG")
Set Cll = Ws.[A:A].Find(S, Ws.[A1], xlValues, xlWhole)
If Cll Is Nothing Then
Set Ws = Sheets("LICH MUA")
Set Cll = Ws.[A:A].Find(S, Ws.[A1], xlValues, xlWhole)
End If
fAdd = Cll.Address
If fAdd = "" Then Exit Sub
Do
k = k + 1
For i = 1 To 6
Arr(k, i) = Cll.Offset(, i - 1)
Next
Set Cll = Ws.[A:A].FindNext(Cll)
Loop Until Cll.Address = fAdd
Sheets("RESULT").[A1].Resize(k, 6) = Arr
End Sub[/GPECODE]

Mình làm phiền thêm bạn chút, thật ngại quá.
Với cách ở trên này, nếu như mình muốn nó xuất kết quả tìm được ở cả 2 sheet "BO SUNG" và "LICH MUA" mà không giới hạn là nếu "BO SUNG" có thì không tìm lịch mùa thì như thế nào nhỉ? Cảm ơn bạn nhiều nếu dành thời gian cho câu hỏi của mình

 

[nghiaphuc]

Mình làm phiền thêm bạn chút, thật ngại quá.
Với cách ở trên này, nếu như mình muốn nó xuất kết quả tìm được ở cả 2 sheet "BO SUNG" và "LICH MUA" mà không giới hạn là nếu "BO SUNG" có thì không tìm lịch mùa thì như thế nào nhỉ? Cảm ơn bạn nhiều nếu dành thời gian cho câu hỏi của mình

Lại sửa thêm chút nữa:
[GPECODE=vb]Sub mSearch()
Dim S As String, Res As String
Sheets("RESULT").Cells.Clear
Res = "Ket qua tim kiem:"
If IsEmpty(ActiveCell) Then Exit Sub
S = Left(ActiveCell.Value, InStr(1, ActiveCell.Value, " ") - 1)
If InStr(1, S, "/") > 0 Then
MySearch Sheets("BO SUNG"), Left(S, InStr(1, S, "/") - 1), Res
MySearch Sheets("LICH MUA"), Left(S, InStr(1, S, "/") - 1), Res
MySearch Sheets("BO SUNG"), Mid(S, InStr(1, S, "/") + 1, Len(S)), Res
MySearch Sheets("LICH MUA"), Mid(S, InStr(1, S, "/") + 1, Len(S)), Res
Else
MySearch Sheets("BO SUNG"), S, Res
MySearch Sheets("LICH MUA"), S, Res
End If
Sheets("RESULT").[1:1].Delete
MsgBox Res
End Sub[/GPECODE]
[GPECODE=vb]Sub MySearch(Ws As Worksheet, S As String, Res As String)
Dim fAdd As String, Cll As Range, k As Long, i As Long, Arr()
ReDim Arr(1 To 100, 1 To 6)
On Error Resume Next
Set Cll = Ws.[A:A].Find(S, Ws.[A1], xlValues, xlWhole)
fAdd = Cll.Address
If fAdd = "" Then Exit Sub
Do
k = k + 1
Res = Res & Chr(10)
For i = 1 To 6
Arr(k, i) = Cll.Offset(, i - 1)
Res = Res & Arr(k, i) & " | "
Next
Set Cll = Ws.[A:A].FindNext(Cll)
Loop Until Cll.Address = fAdd
Sheets("RESULT").[A1000].End(xlUp).Offset(1).Resize(k, 6) = Arr
End Sub[/GPECODE]