Tìm dữ liệu theo nhiều từ khóa khác nhau (1 người xem)

  • Thread starter Thread starter KhoiSMC
  • Ngày gửi Ngày gửi
Elx 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)
K

KhoiSMC

Thành viên thường trực
Tham gia
19/6/09
Bài viết
248
Được thích
32
Chào các bạn GPE,

Mình có bảng dữ liệu được nhập như sau: <sheet: Du lieu>
dl.jpg

- Trong đó có cột "Từ khóa" là cột tham chiếu để lấy kết quả sang sheet: K.tra

Khi nhập từ khóa (tại ô B2, sheet: K.tra) cần tìm kiếm trên sheet: Du lieu thì kết quả như sau:
kq.jpg

(Mỗi từ khóa phân cách nhau bởi dấu ",").

Mong các bạn gợi ý cách giải quyết trường hợp này với ạ, (xin tải file đính kèm để xử lý).

Thanks
Khoi
 

File đính kèm

Bạn thử dùng code sau, dòng code giữa 2 dòng dấu ??? chưa biết thay bằng gì cho đẹp?
Mã: 
Sub Macro1()
 Dim s As String, tk
 Dim arrtk() As String
 Dim i As Long, n As Long
 s = Sheets("K.tra").Range("b2").Text
 Application.ScreenUpdating = False
 Sheets("K.tra").Range("a5:f" & Range("a5").End(xlDown).Row).ClearContents
 arrtk = Split(s, ",")
 n = 5
 Sheets("Du lieu").Activate
 For Each tk In arrtk
    s = Trim(tk)
    Columns("F:F").Select
    On Error GoTo no_key
    Selection.AutoFilter Field:=1, Criteria1:=("=*" & s & "*")
    Range("A3:E12").Select
    i = Selection.Rows.SpecialCells(xlCellTypeVisible).Count / 5
    Selection.Copy Sheets("K.tra").Range("A" & n)
    Sheets("K.tra").Range("f" & n, "f" & (n + i - 1)) = s
    n = n + i
no_key:
Next
Selection.AutoFilter
Application.ScreenUpdating = True
End Sub
 
Lần chỉnh sửa cuối:
Hỏi lại cho rõ:

Trên trang 'Du Lieu' có tới 3 dòng chứa từ khóa 'b2 tk' (đó là các dòng mà ở cột [A] chứa các trị a3, a4 & a9)


Nhưng bên trang kie bạn chỉ gôm về có 2 dòng là sao?
 
Xin lỗi bạn,

Đúng là mình thiếu mục đó bạn ạ. Kết quả mong muốn đúng như sau:
rev.jpg

Nhờ bạn giúp đỡ.

Khoi
 
Mình đang thử đoạn CODE của bạn.

Bạn có nói
Bạn thử dùng code sau, dòng code giữa 2 dòng dấu ??? chưa biết thay bằng gì cho đẹp?
Nhấp chuột vào đây để mở rộng...
là như thế nào nhỉ? mình chưa hiểu lắm.

Thanks
Khoi
 
quanghai1969 đã viết:
Với kiểu file tạm này thì khó ai giúp được. Mình đọc mãi cũng chẳng hiểu được ý bạn muốn gì. Mà kiểu bố trí cơ sở dữ liệu và dk cũng lạ quá.
Nhấp chuột vào đây để mở rộng...

Bài này thì tôi hiểu nè: Người ta muốn lọc nhiều điều kiện cùng lúc. Ví dụ gõ A, B, C thì sẽ lọc vừa có A vừa có B và vừa có C
 
quanghai1969 đã viết:
Với kiểu file tạm này thì khó ai giúp được. Mình đọc mãi cũng chẳng hiểu được ý bạn muốn gì. Mà kiểu bố trí cơ sở dữ liệu và dk cũng lạ quá.
Nhấp chuột vào đây để mở rộng...
Vậy là chú Hải không chơi trò "Nhìn kết quả, đoán đề bài" được rồi, huhu
Híc+-+-+-++-+-+-++-+-+-+
 
@ quanghai1969, ndu96081631

Ý của mình khi nhập các từ khóa vào ô B2 (sheet K.tra) thì tách các từ khóa này ra (mỗi từ khóa cách nhau bởi dấu ",") thành mỗi từ khóa để tìm tại sheet Du lieu.
Căn cứ trên các từ khóa này tìm xem có trùng vào các từ khóa ở cột F (shet Du lieu - cột F - mỗi ô có thể có 1 hoặc nhiều từ khóa) thì lọc ra các cột tương ứng A,B,C,D,E (sheet Du lieu) đưa kết quả tương ứng về sheet K.tra (cột A, B, C, D, E).

Mình gửi file ví dụ này vì file dữ liệu thật của mình cũng tương đối nặng.

Nhờ bạn nghiên cứu giúp đỡ.
Khoi
 
Lần chỉnh sửa cuối:
Bạn xem theo file

,,,,,,, ,,,,,,, ,,,,,,,
 
Lần chỉnh sửa cuối:
KhoiSMC đã viết:
@ quanghai1969, ndu96081631

Ý của mình khi nhập các từ khóa vào ô B2 (sheet K.tra) thì tách các từ khóa này ra (mỗi từ khóa cách nhau bởi dấu ",") thành mỗi từ khóa để tìm tại sheet Du lieu.
Căn cứ trên các từ khóa này tìm xem có trùng vào các từ khóa ở cột F (shet Du lieu - cột F - mỗi ô có thể có 1 hoặc nhiều từ khóa) thì lọc ra các cột tương ứng A,B,C,D,E (sheet Du lieu) đưa kết quả tương ứng về sheet K.tra (cột A, B, C, D, E).

Mình gửi file ví dụ này vì file dữ liệu thật của mình cũng tương đối nặng.

Nhờ bạn nghiên cứu giúp đỡ.
Khoi
Nhấp chuột vào đây để mở rộng...
Hình như bài 11bị nhiễm virut hay sao ấy, không tải được
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
   Dim nguon(), i, j, kq(1 To 10000, 1 To 6), dk
   Dim item, tam, k
   dk = Target.Value
   With Sheets("Du lieu")
      nguon = .Range(.[A3], .[A65536].End(3)).Resize(, 6).Value
   End With
   tam = Split(dk, ",")
   For Each item In tam
      For i = 1 To UBound(nguon)
         If InStr(1, nguon(i, 6), Trim(item), 1) Then
            k = k + 1
            For j = 1 To 5
               kq(k, j) = nguon(i, j)
            Next
            kq(k, 6) = Trim(item)
         End If
      Next
   Next
End If
If k Then [A5:F1000].ClearContents
If k Then [A5].Resize(k, 6) = kq
End Sub
 
quanghai1969 đã viết:
Hình như bài 11bị nhiễm virut hay sao ấy, không tải được
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
   Dim nguon(), i, j, kq(1 To 10000, 1 To 6), dk
   Dim item, tam, k
   dk = Target.Value
   With Sheets("Du lieu")
      nguon = .Range(.[A3], .[A65536].End(3)).Resize(, 6).Value
   End With
   tam = Split(dk, ",")
   For Each item In tam
      For i = 1 To UBound(nguon)
         If InStr(1, nguon(i, 6), Trim(item), 1) Then
            k = k + 1
            For j = 1 To 5
               kq(k, j) = nguon(i, j)
            Next
            kq(k, 6) = Trim(item)
         End If
      Next
   Next
End If
If k Then [A5:F1000].ClearContents
If k Then [A5].Resize(k, 6) = kq
End Sub
Nhấp chuột vào đây để mở rộng...
Cái "Tên" này chân đâu có dài bằng mình mà lúc nào cũng lẹ ghê!
Lỡ "quê độ chạy sau" cũng đưa lên luôn khỏi bõ công viết.
[GPECODE=vb]Public Sub GPEX()
Dim tArr, sArr(), dArr(), I As Long, J As Long, N As Long, K As Long
With Sheets("Du lieu")
sArr = .Range(.[A3], .[A65000].End(xlUp)).Resize(, 6).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 6)
With Sheets("K.Tra")
tArr = Split(Application.WorksheetFunction.Trim(.Range("B2")), ", ")
For N = 0 To UBound(tArr)
For I = 1 To UBound(sArr, 1)
If InStr(sArr(I, 6), tArr(N)) Then
K = K + 1
For J = 1 To 5
dArr(K, J) = sArr(I, J)
Next J
dArr(K, 6) = tArr(N)
End If
Next I
Next N
.[A5:F1000].ClearContents
If K Then .[A5].Resize(K, 6) = dArr
End With
End Sub[/GPECODE]
Chính xác là máy của "đại ca" bị Virus rồi ChanhTQ@ ơi.
 
Lần chỉnh sửa cuối:
Hay quá các bạn ạ,

Code của quanghai1969 và Ba Tê đều chạy tốt.

Thanks, các bạn GPE tốt quá.
Khoi
 
quanghai1969 đã viết:
Hình như bài 11bị nhiễm virut hay sao ấy, không tải được
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
   Dim nguon(), i, j, kq(1 To 10000, 1 To 6), dk
   Dim item, tam, k
   dk = Target.Value
   With Sheets("Du lieu")
      nguon = .Range(.[A3], .[A65536].End(3)).Resize(, 6).Value
   End With
   tam = Split(dk, ",")
   For Each item In tam
      For i = 1 To UBound(nguon)
         If InStr(1, nguon(i, 6), Trim(item), 1) Then
            k = k + 1
            For j = 1 To 5
               kq(k, j) = nguon(i, j)
            Next
            kq(k, 6) = Trim(item)
         End If
      Next
   Next
End If
If k Then [A5:F1000].ClearContents
If k Then [A5].Resize(k, 6) = kq
End Sub
Nhấp chuột vào đây để mở rộng...
Hình như code này....."tèo"
Hãy cẩn thận khi dùng INSTR(), như dữ liệu trong bài, thay "tk a1" trong cell [B2] bằng "a1" xem kết quả ra sao
+-+-+-+Híc+-+-+-+
 
concogia đã viết:
Hình như code này....."tèo"
Hãy cẩn thận khi dùng INSTR(), như dữ liệu trong bài, thay "tk a1" trong cell [B2] bằng "a1" xem kết quả ra sao
+-+-+-+Híc+-+-+-+
Nhấp chuột vào đây để mở rộng...
Khi nào "tèo" thì chủ thớt la làng lên, lúc đó tính tiếp anh ơi. Phải chừa đường viết bài chứ.
 
Thanks concogia,

Đúng trường hợp như bạn mô tả thì code chưa xử lý được, nhờ các bạn gỡ rối để lọc TH này đi ạ,

Thanks
Khoi
 
KhoiSMC đã viết:
Thanks concogia,

Đúng trường hợp như bạn mô tả thì code chưa xử lý được, nhờ các bạn gỡ rối để lọc TH này đi ạ,

Thanks
Khoi
Nhấp chuột vào đây để mở rộng...
Muốn xác định chuỗi s1 (không có dấu ",") có nằm trong chuỗi s2 (ngăn cách bởi dấu ",") ta có thể dùng Split chuỗi s2, gán kết quả vào mảng sau đó so sánh trim(s1) với từng phần tử của mảng đã được xử lý bằng hàm trim.
 
KhoiSMC đã viết:
Thanks concogia,

Đúng trường hợp như bạn mô tả thì code chưa xử lý được, nhờ các bạn gỡ rối để lọc TH này đi ạ,

Thanks
Khoi
Nhấp chuột vào đây để mở rộng...
Chép code sau vào sheet!K.tra
Mã: 
Private Sub worksheet_change(ByVal target As Range)
On Error Resume Next
If target.Address = "$B$2" Then
Set r = Sheets("K.tra").UsedRange
Set d = [A5]
r.Offset(d.Row - r.Row).ClearContents
Set s = Sheets("Du lieu").UsedRange
h = s.Rows.Count
c = s.Columns.Count
st = Split(target, ",")
ReDim a(1 To h * c, 1 To c)
For Each e In st
    For Each cell In s.Columns(6).Cells
        If ", " & Trim(cell) & "," Like "*, " & Trim(e) & ",*" Then
            i = i + 1
            For j = 1 To c - 1
                a(i, j) = cell.Offset(, j - c)
            Next
                a(i, j) = e
        End If
    Next
Next
d.Resize(i, c).Value = a
End If
End Sub
 
yeah đã xử lý được rồi bạn ạ,

Thanks to nginh.
Khoi
 
Tiếp theo bài này, khi mình nhập thông tin tìm kiếm vào ô B1 và D1 và gộp lại để tìm kiếm tại ô B2.
Khi ô B2 thay đổi nhưng kết quả tính toán không được cập nhật kịp thời mà phải làm thủ công là vào ô B2 gõ enter mới tính toán ra kết quả được.
Cho mình hỏi với làm thế nào để khi cập nhật vào ô B1 hoặc D1 thì bảng tính tự tính ra ô B2 và kết quả một cách tự động nhỉ?
<hình ảnh>
Untitled.jpg
<file đính kèm bên dưới>

Thanks
Khoi
 

File đính kèm

- hình như test thử code của các bài ở trên vẫn chưa đạt yêu cầu ... ^^^^, bạn nên đưa file có nội dung "gần giống" với thực tế để mọi người khỏi phải đoán ...
- khi số liệu nhiều thì code có thể khác xa so với số liệu ít (cứ nhìn cách ông Google tìm kiếm là hiểu được phần nào ... --=0)
 
phucbugis đã viết:
- hình như test thử code của các bài ở trên vẫn chưa đạt yêu cầu ... ^^^^, bạn nên đưa file có nội dung "gần giống" với thực tế để mọi người khỏi phải đoán ...
- khi số liệu nhiều thì code có thể khác xa so với số liệu ít (cứ nhìn cách ông Google tìm kiếm là hiểu được phần nào ... --=0)
Nhấp chuột vào đây để mở rộng...

Không ý mình chỉ hỏi làm sao mọi thay đổi của người dùng tác động vào ô B2 thì có thể bố sung đoạn CODE nào để tự động chạy VBA ra kết quả bên dưới thôi.
Bình thường thì mình vẫn làm thủ công là trỏ vào ô B2 và enter thì mới hiện kết quả. <code tìm kiếm đã xong rồi, không cần thay đổi gì cả>.

Khoi
 
KhoiSMC đã viết:
Không ý mình chỉ hỏi làm sao mọi thay đổi của người dùng tác động vào ô B2 thì có thể bố sung đoạn CODE nào để tự động chạy VBA ra kết quả bên dưới thôi.
Bình thường thì mình vẫn làm thủ công là trỏ vào ô B2 và enter thì mới hiện kết quả. <code tìm kiếm đã xong rồi, không cần thay đổi gì cả>.

Khoi
Nhấp chuột vào đây để mở rộng...

- bạn tải file đính kèm kiểm tra kết quả xem có đúng ko nhé !
- nếu kết quả đúng thì off dòng Range("F1") = Range("F1") + 1 đi

Mã: 
Dim tmpTarget As Variant

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("B1,D1")) Is Nothing Then
        Range("F1") = Range("F1") + 1
        tmpTarget = Range("B2").Value
    End If
End Sub

Private Sub Worksheet_Calculate()
    If Range("B2").Value <> tmpTarget Then GPE_loc
End Sub

'Private Sub Worksheet_Change(ByVal Target As Range)
Private Sub GPE_loc()
...
 

File đính kèm

Mã: 
Dim tmpTarget As Variant

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
2.     If Not Intersect(Target, Range("B1,D1")) Is Nothing Then
3.         Range("F1") = Range("F1") + 1
4.         tmpTarget = Range("B2").Value
5.     End If
6. End Sub

Private Sub Worksheet_Calculate()
    If Range("B2").Value <> tmpTarget Then GPE_loc
End Sub

'Private Sub Worksheet_Change(ByVal Target As Range)
Private Sub GPE_loc()
...

Cám ơn bạn, kết quả đúng bạn ạ. Nên mình cũng thử off luôn cả từ dòng 1-->6 đi thấy vẫn đúng không biết có ảnh hưởng gì không.
Trong CODE của bạn bị lặp thủ tục Public Sub GPEX() tại ThisWorkbook và Module1 vậy nên bỏ đi ở chỗ nào bạn nhỉ?

Thanks
Khoi
 
Cám ơn bạn, kết quả đúng bạn ạ. Nên mình cũng thử off luôn cả từ dòng 1-->6 đi thấy vẫn đúng không biết có ảnh hưởng gì không.
Trong CODE của bạn bị lặp thủ tục Public Sub GPEX() tại ThisWorkbook và Module1 vậy nên bỏ đi ở chỗ nào bạn nhỉ?
Thanks
Khoi[/QUOTE]

ah,
mình đưa thử code của bác Batê để Run xem sao đó mà --> bạn bỏ code của Module1 đi là được.
 
Cám ơn bạn phucbugis,

Như vậy để có chạy VBA tự động khi dữ liệu đầu vào có thay đổi chỉ cần thêm đoạn CODE sau:

Mã: 
Dim tmpTarget As VariantPrivate
Sub Worksheet_Calculate()
    If Range("B2").Value <> tmpTarget Then GPE_loc            '<-- Tên thủ tục sẽ chạy khi B2 có biến động
End Sub

Cám ơn bạn nhiều
Khoi
 
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

B
Xin viết giúp công thức xếp loại
Trả lời
8
Đọc
153
bs2
B
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro (3 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
50
Đọc
21K
dinhthanh1990
D
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
4 5 6
Trả lời
560
Đọc
74K
hoidebiet1710
hoidebiet1710
L
Nhờ anh, chị, chú, bác viết giùm em VBA tìm dữ liệu qua nhiều sheet và trích dòng dữ liệu (1 người xem)
Trả lời
0
Đọc
31
lagannini
L
H
Tổng hợp Công Nợ theo Công trình (1 người xem)
Trả lời
53
Đọc
2K
HangktGTN
H
HeSanbi
Tiện ích Web: Tự động nhấn nút "Bỏ qua" quảng cáo Youtube
    • Thích
Trả lời
3
Đọc
606
tieutuvodanh192
tieutuvodanh192
L
Phân Bổ Doanh Thu Theo Năm
Trả lời
8
Đọc
259
lalaland1991
L
C
Fix lỗi Application.InputBox Type:=8
    • Cười
Trả lời
19
Đọc
375
ptm0412
ptm0412
2
Tìm và tính số khối
Trả lời
4
Đọc
159
2007thanhlp
2
GPE-Trợ Lý
[GPE20] BIỂU ĐỒ CHUYÊN NGHIỆP: PHÁ VỠ GIỚI HẠN 2 TRỤC CỦA EXCEL (1 người xem)
    • Yêu thích
    • Thích
Trả lời
0
Đọc
3K
GPE-Trợ Lý
GPE-Trợ Lý
E
  • Đã giải quyết
VBA tìm giá trị theo điều kiện
Trả lời
15
Đọc
252
eagle12
E
L
  • Question Question
Sữa code tách riêng từng cột và hiện số thập phân trong file theo dõi tồn kho (1 người xem)
Trả lời
3
Đọc
155
luongcongdua
L
GPE-Trợ Lý
[GPE19] DÙNG AI VIẾT VBA TỰ ĐỘNG HÓA GỬI EMAIL
    • Yêu thích
Trả lời
2
Đọc
1K
GPE-Trợ Lý
GPE-Trợ Lý
M
VBA - Tìm kiếm dữ liệu với nhiều điều kiện
Trả lời
21
Đọc
3K
Doãn Ngọc Nhiên
D
Quy Vu
Lỗi không thể Ctrl +Z ( Undo Typing) ???
Trả lời
5
Đọc
6K
vanle33
vanle33
Nguyễn Duy Tuân
  • Dán lên cao
Phiên bản mới Add-in A-Tools AI v10 (2024) (1 người xem)
    • Thích
Trả lời
60
Đọc
10K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
N
File chia băng tự động từ cuộn mẹ theo khổ băng và khối lượng băng cho trước
Trả lời
2
Đọc
163
hoangtuaotrang_hp_vn
H
N
xin các cao thủ chỉ cách gỡ lỗi không khởi động được excel
Trả lời
6
Đọc
999
thaithanhsang2109
T
B
  • Question Question
Thiết lập code VBA để đổi tên sheet tự động theo ngày và sao chép hàm tự động
    • Cười
Trả lời
7
Đọc
230
SA_DQ
SA_DQ
A
  • Question Question
Sửa code VBA nhập liệu userform
Trả lời
26
Đọc
1K
ptm0412
ptm0412
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