LỌC VÀ TÌM KIẾM NHIỀU ĐIỀU KIỆN (3 người xem)

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)
huonglien1901

huonglien1901

GPE là ngôi nhà thứ 2 của tôi!!!
Tham gia
17/4/16
Bài viết
2,701
Được thích
2,434
Giới tính
Nam
Nghề nghiệp
Nhân viên kỹ thuật in ấn
Chào mọi người!

em có hai vấn đề nhờ mọi người hỗ trợ giúp!

Trong file này em có 2 sheet: DATA, KET QUA

Trong sheet kết quả em muốn lọc nhiều tillcode đê lọc lấy ra tất cả dữ liệu thuộc điều kiện đó và vá sắp xếp lại với nhau
Ví dụ một tillcode khi lọc ra hai kết quả lấy hai kết quả đó và khi lấy tiilcode thứ 2 mà tillcode có 3 kết quả thì lấy dữ liệu nằm kế tiếp.
em ví dụ: Tillcode 4306672760102 có hai kết quả được lấy ra.
Và cho biết vị trí kết quả nằm ở dòng nào ở trong sheet DATA.

Em cảm ơn mọi người nhiều!
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
Bạn thử cái này xem sao
Mã: 
Sub Locdulieu()
    Dim sArr(), dArr(), I As Long, J As Long, K As Long, ma
ma = Sheet2.Range("E2")
With Sheet1
    sArr = .Range("A4", .Range("I65535").End(3)).Value
End With
ReDim dArr(1 To UBound(sArr), 1 To 10)
For I = 1 To UBound(sArr)
    If sArr(I, 2) = ma Then
        K = K + 1
        For J = 1 To 9
            dArr(K, J) = sArr(I, J)
        Next J
        dArr(K, 10) = I + 3
    End If
Next I
With Sheet2
    If K Then
        Range("A5").Resize(K, 10) = dArr
    Else
        MsgBox "Khong tim thay du lieu"
    End If
End With
End Sub
 
Upvote 0
PacificPR đã viết:
Bạn thử cái này xem sao
Mã: 
Sub Locdulieu()
    Dim sArr(), dArr(), I As Long, J As Long, K As Long, ma
ma = Sheet2.Range("E2")
With Sheet1
    sArr = .Range("A4", .Range("I65535").End(3)).Value
End With
ReDim dArr(1 To UBound(sArr), 1 To 10)
For I = 1 To UBound(sArr)
    If sArr(I, 2) = ma Then
        K = K + 1
        For J = 1 To 9
            dArr(K, J) = sArr(I, J)
        Next J
        dArr(K, 10) = I + 3
    End If
Next I
With Sheet2
    If K Then
        Range("A5").Resize(K, 10) = dArr
    Else
        MsgBox "Khong tim thay du lieu"
    End If
End With
End Sub
Nhấp chuột vào đây để mở rộng...

Ý em cho kết quả nằm ở sheet KETQUA đó anh, em muốn lọc nhiều tillcode luôn không phải 01 cái anh, khi em lọc nhiều tillcode cái nào lấy trước thì lấy trước rồi cứ thế tiếp tục đó anh.
Ví dụ em đưa lên cho mọi người dễ hiểu đó Anh!
 
Upvote 0
huonglien1901 đã viết:
Ý em cho kết quả nằm ở sheet KETQUA đó anh, em muốn lọc nhiều tillcode luôn không phải 01 cái anh, khi em lọc nhiều tillcode cái nào lấy trước thì lấy trước rồi cứ thế tiếp tục đó anh.
Ví dụ em đưa lên cho mọi người dễ hiểu đó Anh!
Nhấp chuột vào đây để mở rộng...
Vậy tạo 1 cái Data Validatinon nữa là được rồi.
Bạn Copy cái này vào Sheet2
Mã: 
Private Sub Worksheet_Activate()
    Dim Dic As Object, I As Long, K As Long
    Dim Tmp As String, sArr, dArr
With Sheet1
    sArr = .Range("B4", .Range("B65000").End(3))
End With
ReDim dArr(1 To UBound(sArr), 1 To 1)
Set Dic = CreateObject("Scripting.Dictionary")
With Dic
    For I = 1 To UBound(sArr)
        If Len(sArr(I, 1)) Then
            Tmp = sArr(I, 1)
            If Not .Exists(Tmp) Then
                K = K + 1
                .Add Tmp, K
                dArr(K, 1) = Tmp
            End If
        End If
    Next I
End With
With Sheet2
    .Range("V2").Resize(1000).ClearContents
    .Range("V2").Resize(K) = dArr
    .Range("V2").Resize(K).Name = "LIST"
    .Range("E2").Validation.Delete
    .Range("E2").Validation.Add 3, , , "=LIST"
End With
Set Dic = Nothing
End Sub
Format cột V thành dạng số
 

File đính kèm

Upvote 0
PacificPR đã viết:
Vậy tạo 1 cái Data Validatinon nữa là được rồi.
Bạn Copy cái này vào Sheet2
Mã: 
Private Sub Worksheet_Activate()
    Dim Dic As Object, I As Long, K As Long
    Dim Tmp As String, sArr, dArr
With Sheet1
    sArr = .Range("B4", .Range("B65000").End(3))
End With
ReDim dArr(1 To UBound(sArr), 1 To 1)
Set Dic = CreateObject("Scripting.Dictionary")
With Dic
    For I = 1 To UBound(sArr)
        If Len(sArr(I, 1)) Then
            Tmp = sArr(I, 1)
            If Not .Exists(Tmp) Then
                K = K + 1
                .Add Tmp, K
                dArr(K, 1) = Tmp
            End If
        End If
    Next I
End With
With Sheet2
    .Range("V2").Resize(1000).ClearContents
    .Range("V2").Resize(K) = dArr
    .Range("V2").Resize(K).Name = "LIST"
    .Range("E2").Validation.Delete
    .Range("E2").Validation.Add 3, , , "=LIST"
End With
Set Dic = Nothing
End Sub
Format cột V thành dạng số
Nhấp chuột vào đây để mở rộng...

code anh lần đầu tiên lấy ra thì đúng nhưng chọn lần 2 nó sẽ lấy sai,

em ví dụ code 4306672760102 có 2 kết quả lấy ra nhưng khi em lấy thêm 01 tillcode nữa thì nó mất đi kết quả 1 và thêm kết quả vào đó.
em gửi lại Anh file Tham khảo cho Anh dễ hiểu
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
huonglien1901 đã viết:
code anh lần đầu tiên lấy ra thì đúng nhưng chọn lần 2 nó sẽ lấy sai,

em ví dụ code 4306672760102 có 2 kết quả lấy ra nhưng khi em lấy thêm 01 tillcode nữa thì nó mất đi kết quả 1 và thêm kết quả vào đó.
em gửi lại Anh file Tham khảo cho Anh dễ hiểu
Nhấp chuột vào đây để mở rộng...
Thử code Này xem sao . hy vọng trúng
Mã: 
Sub FILTER()
Dim Crits As Range, Extrs As Range, Data As Range
Application.ScreenUpdating = False
           Sheet2.Range("A4:J4").Copy Sheet2.Range("A65000").End(3).Offset(1)
           Set Data = Sheet1.Range("A3").CurrentRegion
           Set Crits = Sheet2.Range("E1:E2")
           Set Extrs = Sheet2.Range("A65000").End(3).Resize(1, 10)
           Data.AdvancedFilter 2, Crits, Extrs, False
    With Sheet2
          .Range("A4").CurrentRegion.AutoFilter 1, "Quay"
          .Range("A4").CurrentRegion.Offset(1).Delete (3)
          .Range("A4").CurrentRegion.AutoFilter
          .Range("A4").CurrentRegion.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10), Header:=xlYes
     End With
       Application.ScreenUpdating = True
End Sub
 

File đính kèm

Upvote 0
Lê Duy Thương đã viết:
Thử code Này xem sao . hy vọng trúng
Mã: 
Sub FILTER()
Dim Crits As Range, Extrs As Range, Data As Range
Application.ScreenUpdating = False
           Sheet2.Range("A4:J4").Copy Sheet2.Range("A65000").End(3).Offset(1)
           Set Data = Sheet1.Range("A3").CurrentRegion
           Set Crits = Sheet2.Range("E1:E2")
           Set Extrs = Sheet2.Range("A65000").End(3).Resize(1, 10)
           Data.AdvancedFilter 2, Crits, Extrs, False
    With Sheet2
          .Range("A4").CurrentRegion.AutoFilter 1, "Quay"
          .Range("A4").CurrentRegion.Offset(1).Delete (3)
          .Range("A4").CurrentRegion.AutoFilter
          .Range("A4").CurrentRegion.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10), Header:=xlYes
     End With
       Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...

Dạ code ra đúng rồi Anh ơi, Ví dụ code tim không ra nhấn tillcode sai thì viết code như thế nào Anh ơi.
Ví dụ em muốn khi nhập tillcode sai thì hiện bảng thông báo code này không đúng vui lòng nhập lại

Em cảm ơn Anh!
 
Upvote 0
huonglien1901 đã viết:
Ý em cho kết quả nằm ở sheet KETQUA đó anh, em muốn lọc nhiều tillcode luôn không phải 01 cái anh, khi em lọc nhiều tillcode cái nào lấy trước thì lấy trước rồi cứ thế tiếp tục đó anh.
Ví dụ em đưa lên cho mọi người dễ hiểu đó Anh!
Nhấp chuột vào đây để mở rộng...
Chuột phải vào sheettab "ket qua", dán đoạn code này vào, thay đổi E2 xem sao
Mã: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$2" Then
    Dim SArr, Res
    Dim i, j, rw

    For Each Res In Range("B4", Range("B1000000").End(xlUp))
        If Res = Target Then Exit Sub
    Next Res
    SArr = Sheet1.Range("A3").CurrentRegion
  
    For i = 2 To UBound(SArr)
        If SArr(i, 2) = Target Then rw = rw & " " & i
    Next i
  
    If Trim(rw) <> "" Then
        rw = Split(Trim(rw))
        ReDim Res(1 To UBound(rw) + 1, 1 To UBound(SArr, 2))
        For i = 0 To UBound(rw)
            rw(i) = CLng(rw(i))
            For j = 1 To UBound(SArr, 2)
                Res(i + 1, j) = SArr(rw(i), j)
            Next j
        Next i
        Range("A1000000").End(xlUp).Offset(1).Resize(UBound(Res), UBound(Res, 2)) = Res
    Else
        MsgBox ("Code khong dung. Lam lai de")
    End If
End If
End Sub
 
Upvote 0
TheThienChu đã viết:
Chuột phải vào sheettab "ket qua", dán đoạn code này vào, thay đổi E2 xem sao
Mã: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$2" Then
    Dim SArr, Res
    Dim i, j, rw

    For Each Res In Range("B4", Range("B1000000").End(xlUp))
        If Res = Target Then Exit Sub
    Next Res
    SArr = Sheet1.Range("A3").CurrentRegion
 
    For i = 2 To UBound(SArr)
        If SArr(i, 2) = Target Then rw = rw & " " & i
    Next i
 
    If Trim(rw) <> "" Then
        rw = Split(Trim(rw))
        ReDim Res(1 To UBound(rw) + 1, 1 To UBound(SArr, 2))
        For i = 0 To UBound(rw)
            rw(i) = CLng(rw(i))
            For j = 1 To UBound(SArr, 2)
                Res(i + 1, j) = SArr(rw(i), j)
            Next j
        Next i
        Range("A1000000").End(xlUp).Offset(1).Resize(UBound(Res), UBound(Res, 2)) = Res
    Else
        MsgBox ("Code khong dung. Lam lai de")
    End If
End If
End Sub
Nhấp chuột vào đây để mở rộng...

Dạ, code ra đúng Anh ơi nhưng khi em nhập sai thì nó không báo sai dữ liệu như code anh nói!

Em nhờ Anh tạo cho em nút XOA DU LIEU được không Anh?
 

File đính kèm

Upvote 0
Nên xài macro sự kiện tại [E2] thay vì nút {RUN};
Bằng ngược lại sẽ là vầy:
PHP: 
Sub FILTER()
 Dim Crits As Range, Extrs As Range, Data As Range
 Application.ScreenUpdating = False
 Sheet2.Range("A4:J4").Copy Sheet2.Range("A65000").End(3).Offset(1)
 Set Data = Sheet1.Range("A3").CurrentRegion
 Set Crits = Sheet2.Range("E1:E2")
 Set Extrs = Sheet2.Range("A65000").End(3).Resize(1, 10)
 Data.AdvancedFilter 2, Crits, Extrs, False
   
 With Sheet2
    .Range("A4").CurrentRegion.AutoFilter 1, "Quay"
    .Range("A4").CurrentRegion.Offset(1).Delete (3)
    .Range("A4").CurrentRegion.AutoFilter
    .Range("A4").CurrentRegion.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10), Header:=xlYes
    Application.ScreenUpdating = True
    If .Range("A4").CurrentRegion.Rows.Count = 1 Then
        MsgBox "Nothing"
    End If
 End With
End Sub
 
Upvote 0
Hoang2013 đã viết:
Nên xài macro sự kiện tại [E2] thay vì nút {RUN};
Bằng ngược lại sẽ là vầy:
PHP: 
Sub FILTER()
 Dim Crits As Range, Extrs As Range, Data As Range
 Application.ScreenUpdating = False
 Sheet2.Range("A4:J4").Copy Sheet2.Range("A65000").End(3).Offset(1)
 Set Data = Sheet1.Range("A3").CurrentRegion
 Set Crits = Sheet2.Range("E1:E2")
 Set Extrs = Sheet2.Range("A65000").End(3).Resize(1, 10)
 Data.AdvancedFilter 2, Crits, Extrs, False
  
 With Sheet2
    .Range("A4").CurrentRegion.AutoFilter 1, "Quay"
    .Range("A4").CurrentRegion.Offset(1).Delete (3)
    .Range("A4").CurrentRegion.AutoFilter
    .Range("A4").CurrentRegion.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10), Header:=xlYes
    Application.ScreenUpdating = True
    If .Range("A4").CurrentRegion.Rows.Count = 1 Then
        MsgBox "Nothing"
    End If
 End With
End Sub
Nhấp chuột vào đây để mở rộng...
Anh Hoàng ơi code báo lỗi 1004 đó Anh
upload_2017-5-5_14-38-50.png
 
Upvote 0
Upvote 0
huonglien1901 đã viết:
Chào mọi người!

em có hai vấn đề nhờ mọi người hỗ trợ giúp!

Trong file này em có 2 sheet: DATA, KET QUA

Trong sheet kết quả em muốn lọc nhiều tillcode đê lọc lấy ra tất cả dữ liệu thuộc điều kiện đó và vá sắp xếp lại với nhau
Ví dụ một tillcode khi lọc ra hai kết quả lấy hai kết quả đó và khi lấy tiilcode thứ 2 mà tillcode có 3 kết quả thì lấy dữ liệu nằm kế tiếp.
em ví dụ: Tillcode 4306672760102 có hai kết quả được lấy ra.
Và cho biết vị trí kết quả nằm ở dòng nào ở trong sheet DATA.

Em cảm ơn mọi người nhiều!
Nhấp chuột vào đây để mở rộng...
Bạn diễn giải dùm câu này:
" MUỐN TẠO MỘT LIST ĐÊ LỌC NHIỀU ĐIỀU KIỆN THÌ KẾT QUẢ CÓ BAO NHIÊU THÌ SẼ LẤY HẾT VÀ CỨ THẾ TIẾP TỤC"
Tạo một list thỏa mãn những điều kiện như nào?
Lọc nhiều điều kiện thì gồm những điều kiện nào?
Cứ thế tiếp tục là như nào? Chưa rõ cái lần thứ hai như nào mà: "khi lấy tillcode thứ 2 mà tillcode có 3 kết quả thì lấy dữ liệu nằm kế tiếp". Lấy dữ liệu nằm kế tiếp là như nào? kế tiếp cái gì?

huonglien1901 đã viết:
tạo cho em nút XOA DU LIEU
Nhấp chuột vào đây để mở rộng...
Xóa dữ liệu ở đâu? sheet nào?

Đọc cả topic mà chưa thể rõ bạn muốn cái gì...
 
Upvote 0
befaint đã viết:
Bạn diễn giải dùm câu này:
" MUỐN TẠO MỘT LIST ĐÊ LỌC NHIỀU ĐIỀU KIỆN THÌ KẾT QUẢ CÓ BAO NHIÊU THÌ SẼ LẤY HẾT VÀ CỨ THẾ TIẾP TỤC"
Tạo một list thỏa mãn những điều kiện như nào?
Lọc nhiều điều kiện thì gồm những điều kiện nào?
Cứ thế tiếp tục là như nào? Chưa rõ cái lần thứ hai như nào mà: "khi lấy tillcode thứ 2 mà tillcode có 3 kết quả thì lấy dữ liệu nằm kế tiếp". Lấy dữ liệu nằm kế tiếp là như nào? kế tiếp cái gì?


Xóa dữ liệu ở đâu? sheet nào?

Đọc cả topic mà chưa thể rõ bạn muốn cái gì...
Nhấp chuột vào đây để mở rộng...
Dữ liệu kế tiếp là như thế này:
Một Tillcode có hai kết quả thì tillcode thứ 2 sẽ nằm dưới 2 kết quả đó và cứ tiếp tuc như vậy!
Thì em muốn lấy kết quả ra rồi và muốn xóa dữ liệu trên sheet kết quả để nhập giá trị khác đó Anh, điều kiện là Tillcode đó Anh

Em gủi file Anh xem nhé!
 

File đính kèm

Upvote 0
huonglien1901 đã viết:
Thì em muốn lấy kết quả ra rồi và muốn xóa dữ liệu trên sheet kết quả để nhập giá trị khác đó Anh, điều kiện là Tillcode đó Anh

Em gủi file Anh xem nhé!
Nhấp chuột vào đây để mở rộng...
Tôi bảo đọc cả topic thì tức đã xem cái file đó bạn đính kèm ở bài #5.
Bạn biểu đạt yêu cầu của mình rõ ràng, chi tiết, chứ cứ nêu cái bạn đã biết làm chi.
 
Upvote 0
TheThienChu đã viết:
Bạn nhập sai thế nào?
Nhấp chuột vào đây để mở rộng...
ý là em nhập sai code thiếu hoặc sai thì không thông báo gì cả chỉ có DATAVALIDATION báo lỗi thôi. Nên em nhờ Anh khi gõ code sai hoặc thiếu thì hiển thị dòng thông báo, "Code này không đúng vui lòng nhập lại!"
Và anh ơi tạo cho em nút XOA DU LIEU trong sheet Ketqua đó Anh!

Em cảm ơn Anh!
 
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

H
chuyển dữ liệu từ 1 dòng thành nhiều dòng,
Trả lời
11
Đọc
96
thuytrangbp28
T
K
Hỏi lỗi không kéo được công thức (Ctrl+D)
Trả lời
7
Đọc
92
khoinguyen2024
K
C
Filter có điều kiện đang ở dạng Cột
Trả lời
3
Đọc
85
Chí Còn Phí
C
H
Quản Lý Công Văn đi Và đến (1 người xem)
9 10 11
Trả lời
216
Đọc
159K
dungnguyenMNCK
D
Nguyễn Duy Tuân
Hướng dẫn lập trình với Google Sheets và Excel Online bằng Excel VBA và Add-in A-Tools v10
    • Thích
Trả lời
10
Đọc
548
Nguyễn Duy Tuân
Nguyễn Duy Tuân
dongbhhg
Tìm lương cơ sở theo từng tháng
Trả lời
2
Đọc
41
Duy Tùng 9x
Duy Tùng 9x
Quách Ngọc
Trả về kết quả ngày tháng hay khoảng trống (1 người xem)
Trả lời
2
Đọc
22
Duy Tùng 9x
Duy Tùng 9x
TrungChinhs
  • Question Question
Hỏi cách làm tròn số trong VBA
Trả lời
6
Đọc
7K
ngocbinh.no.kia
N
Vũ Thị Thuý Ly
Em xin nhờ các anh chị trên diễn đàn giúp đỡ viết hàm hoặc VBA tính tổng các giá trị theo điều kiện
Trả lời
3
Đọc
32
bebo021999
B
DinhManh1307
Cách thống kê công việc sản xuất từng người để tính lương sản phẩm
Trả lời
16
Đọc
255
DinhManh1307
DinhManh1307
tonny jj
Lập hàm thể hiện số công lệnh của ngày đi công tác
Trả lời
6
Đọc
187
thuytrangbp28
T
V
Làm mẫu giấy đi đường (công lệnh) bằng Excel
Trả lời
10
Đọc
11K
SA_DQ
SA_DQ
B
Xin hướng dẫn cách để hàm Xlookup tự hiển thị theo số dòng có chứa điều kiện tìm kiếm ko dùng VBA
Trả lời
9
Đọc
126
thuytrangbp28
T
V
Help: Hàm đếm lọc giá trị trùng
    • Cười
Trả lời
17
Đọc
135
SA_DQ
SA_DQ
R
Chuyển count thành sum khi pivot
Trả lời
4
Đọc
8K
ptm0412
ptm0412
T
tìm ra số tháng mà lượng hàng nhập ban đầu sử dụng hết
    • Cười
Trả lời
2
Đọc
91
TramAnhNguyen692
T
S
NHỜ ANH EM GIÚP MÌNH TÌM KIẾM DỮ LIỆU
Trả lời
12
Đọc
156
sangdennh
S
L
Có ai biết fix lỗi này không ạ
    • Buồn
Trả lời
2
Đọc
61
lekimhuy0812
L
GPE-Trợ Lý
[GPE] TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
    • Thích
Trả lời
1
Đọc
3K
PhanTuHuong
PhanTuHuong
K
Lỗi cấu trúc hình ảnh khi mở file bằng điện thoại
Trả lời
0
Đọc
39
Kecodonlalala
K
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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom