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

  • Thread starter Thread starter KhoiSMC
  • Ngày gửi Ngày gửi
Liên hệ QC

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

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?
là như thế nào nhỉ? mình chưa hiểu lắm.

Thanks
Khoi
 
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á.

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
 
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á.
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:
@ 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
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
 
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
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
 
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
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+-+-+-+
 
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+-+-+-+
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
 
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
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.
 
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
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
 
Web KT

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

Trả lời
42
Đọc
17K
Back
Top Bottom