Hỏi về cách lọc dữ liệu mà không dùng filter or sort.

[jb007]

Nhờ các huynh giúp mình. Mình có up file đính kèm (hôm wa up không được nên chắc mod xoá bài rồi. Thanks mod nhiều nhé.) Mình muốn lọc ra ai đi, đi đâu, khi nào về, ... . bất cứ thứ gì. Thanks

 

[viendo]

Bạn xem file đính kèm nhé, dùng Name và công thức.

 

[rollover79]

Thêm 1 cách nữa cho bạn tham khảo, thêm cột phụ rồi dùng VLOOKUP cho thân thiện

 

[SA_DQ]

Dùng macro sự kiện đây, mại zô!

Hướng dẫn sử dụng trước khi dùng:
Trước tiên chọn hướng công tác theo ComboBox Đi/Về
Nhập ngày vô [F2] & {ENTER}

Có thể ta đổi lại quy trình, nếu muốn"
* Nhập ngày trước vô [F2],
* sau đó chọn hướng đi/về
Thì macro sẽ lập cho ta danh sách thích ứng; Lúc đó bạn nhớ chuyển macro sang module1 & gắn macro vô hộp ComboBox
(Nếu bạn không tự ên được sẽ có người giúp tiếp)

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [f2]) Is Nothing And IsDate(Target) Then
   Dim Col As Long, lRw As Long
   Dim sRng As Range, Rng As Range, Clls As Range
   Dim GPE_ As String, sDate As String
 
   Col = [g1].Value + 1
   With Sheets("data")
      lRw = .Cells(65500, Col).End(xlUp).Row
      Set sRng = .Range(.Cells(4, Col), .Cells(lRw, Col))
      sDate = Format(Target, "Short Date")
      sRng.NumberFormat = "m/d/yyyy"
      Set Rng = sRng.Find(What:=CDate(sDate), LookIn:=xlValues)
      If Not Rng Is Nothing Then
         GPE_ = Rng.Address
         Do
            If Clls Is Nothing Then
               Set Clls = Rng.Offset(, 1 - Col).Resize(, 5)
            Else
               Set Clls = Union(Clls, Rng.Offset(, 1 - Col).Resize(, 5))
            End If
            Set Rng = sRng.FindNext(Rng)
         Loop While Not Rng Is Nothing And Rng.Address <> GPE_
      Else:                MsgBox "Ngay Nay Chua Co Trong Du Lieu."
      End If
      If Not Clls Is Nothing Then
         Sheets("tim").Range("A4:E" & lRw).Clear
         Clls.Copy Destination:=Sheets("tim").[a4]
      End If
   End With
 ElseIf Not Intersect(Target, [f2]) Is Nothing Then
   MsgBox "Hay Nhap Vao [F2] Tri Ngay", , "GPE.COM"
 End If
End Sub

 

[boyxin]

Nhờ các huynh giúp mình. Mình có up file đính kèm (hôm wa up không được nên chắc mod xoá bài rồi. Thanks mod nhiều nhé.) Mình muốn lọc ra ai đi, đi đâu, khi nào về, ... . bất cứ thứ gì. Thanks

Từ File của bác HYen17, boyxin thêm tý gia vị cho nó hấp dẫn

 

[jb007]

Xin cảm ơn các bác, nếu được làm dùm thêm 1 form nhập user name và password khi mở file và hiện tên user name ở góc rái trên khi in sheet "tim". thanks!

 

[sunsco]

Chia ra Từng HS A, B, C mà không dùng sort và Filter

Hoc sinh Chieu cao
A 1.85
B 1.65
C 1.85
B 1.70
C 1.55
A 1.50
C 1.75
A 1.65
B 1.60
...

Bài toán đặt ra là làm sao lọc được từng hs A, B, C...

 

[hoangvuluan]

Chia sup không dùng sort và filter

Không upfile được, hướng dẫn 1 cách xem thế nào:
1. Giả sử, dữ liệu được nhập ở 2 cột A (Sup) và B (value) từ dòng 3 là tiêu đề.
2. Lấy các sup ở các cột E, F, G
3. Dòng 2: E2, F2, G2 chứa hàm đếm tổng số các sup tương ứng (với dữ liệu mà bạn đã gửi thì các sup lần lượt là: 8, 13 và 8)
4. Dòng 3: E3, F3, G3 chứa các nhãn của sup (A, B và C)
5. Nhập công thức ở ô E4 như sau:
(xin lỗi công thức có nhầm lẫn, sẽ chỉnh sửa lại sau)
6. Kéo công thức đến dòng cuối cùng và sang phải 2 cột, ta thu được giá trị các sub tương ứng.


Hy vọng giải quyết được yêu cầu của bạn.
-hvl-

 

[lucky999]

Các bạn giúp mình theo file đính kèm. và các bạn có thể giúp mình hoàn chỉnh để hoàn thiện hơn nhé. thanks

 

[hoangdanh282vn]

Các bạn giúp mình theo file đính kèm. và các bạn có thể giúp mình hoàn chỉnh để hoàn thiện hơn nhé. thanks

Bạn xem file đính kèm nha :

 

[boyxin]

Các bạn giúp mình theo file đính kèm. và các bạn có thể giúp mình hoàn chỉnh để hoàn thiện hơn nhé. thanks

Cho boyxin góp vui với

các bác xem code rồi góp ý cho boyxin nhé
​

 

[hoangdanh282vn]

Cách sử dụng VBA :

Sub worksheet_change(ByVal Target As Range)
Dim SCell As Range, ERow As Long, SRow As Long
If Target.Address = "$F$6" Then
With Application
.EnableEvents = False: .ScreenUpdating = False: .CutCopyMode = False
    [F7:F65536].ClearContents
    ERow = [E65536].End(xlUp).Row
    [C7].Select
    Set SCell = Range("C7:C" & ERow).Find([F6], ActiveCell, xlValues, xlWhole)
        If Not SCell Is Nothing Then
        SRow = SCell.Row
        Range(Cells(SRow, 5), Cells(.WorksheetFunction.Min(SCell.End(xlDown).Row, ERow), 5)).Copy
        [F7].PasteSpecial Paste:=xlPasteValues
        [F6].Select
        Else: MsgBox "Khong tim thay!"
        End If
    Set SCell = Nothing
.EnableEvents = True: .ScreenUpdating = True: .CutCopyMode = True
End With
End If
End Sub

 

[hoangdanh282vn]

Cho boyxin góp vui với
​

các bác xem code rồi góp ý cho boyxin nhé​

Sub worksheet_change(ByVal Target As Range)
If Target.Address = "$G$6" Then
With Application
.DisplayAlerts = False
.ScreenUpdating = False
[COLOR=red]End With[/COLOR]
If [g6] <= [COLOR=red]Application[/COLOR].WorksheetFunction.Count(Columns("C:C")) And [g6] > 0 Then
Range([f7], [f7].End(xlDown)).ClearContents
Columns("C:C").Select
vt1 = Selection.Find(What:=[g6], After:=ActiveCell, LookIn:=-4163, LookAt:=[COLOR=red]2[/COLOR]).Row
If [g6] = [COLOR=red]Application[/COLOR].WorksheetFunction.Count(Columns("C:C")) Then
vt2 = [e65535].End(xlUp).Row
Else
vt2 = Selection.Find(What:=[g6] + 1, After:=ActiveCell, LookIn:=-4163, LookAt:=[COLOR=red]2[/COLOR]).Row - 1
End If
j = 6
For i = vt1 To vt2
j = j + 1
Cells(j, 6) = Cells(i, 5)
Next
[g6].Select
Else
MsgBox "Khong tim thay. Nhan OK de nhap lai"
End If
[COLOR=red]With Application[/COLOR]
.DisplayAlerts = True
.ScreenUpdating = True
End With
End If
End Sub

Anh xem gợi ý của em ở phần bôi đỏ nhé.
Anh nên thận trọng với hàm Count, rất dễ nhầm lẫn và sai sót
Riêng với Find, Anh nên chọn tham số xlWhole mới chính xác.

 

[boyxin]

Anh xem gợi ý của em ở phần bôi đỏ nhé.
Anh nên thận trọng với hàm Count, rất dễ nhầm lẫn và sai sót
Riêng với Find, Anh nên chọn tham số xlWhole mới chính xác.

cảm ơn hoangdanh282vn đã góp ý, boyxin sửa lại thế này

Sub worksheet_change(ByVal Target As Range)
If Target.Address = "$G$6" Then
With Application
       .DisplayAlerts = False
       .ScreenUpdating = False
    Range([f7], [f65535].End(xlUp)).ClearContents
    Columns("C:C").Select
    Set Clls = Selection.Find([G6], ActiveCell, xlValues, 1)
    If Not Clls Is Nothing Then
        vt1 = Clls.Row
        If Clls.Row = [C65535].End(xlUp).Row Then
            vt2 = [e65535].End(xlUp).Row
        Else
            vt2 = Selection.Find([G6] + 1, ActiveCell, xlValues, 1).Row - 1
        End If
        Range("F7:F" & 7 + vt2 - vt1).Value = Range("E" & vt1 & ":E" & vt2 + 1).Value
        [G6].Select
    Else
        MsgBox "Khong tim thay. Nhan OK de nhap lai"
    End If
       .DisplayAlerts = True
       .ScreenUpdating = True
End With
End If
End Sub

Thiếu phần Dim code vẫn chạy tốt, không biết có ảnh hưởng gì khi dữ liệu lớn không nhỉ?

--------------------
Code của Danh lấy thừa dòng cuối

 

[ndu96081631]

Thử code này cũng khá đơn giản đây (thuật toán chủ yếu là End(xlDown) )

Sub Worksheet_Change(ByVal Target As Range)
  Dim Src As Range, Des As Range, StRng As Range, EnRng As Range
  On Error Resume Next
  If Target.Address = "$G$6" Then
    Set Src = [A5].CurrentRegion.Offset(2, 2).Resize(, 1)
    Set Des = [G6].CurrentRegion.Offset(1)
    Set StRng = Src(WorksheetFunction.Match([G6].Value, Src, 0))
    Set EnRng = StRng.End(xlDown).Offset(-1)
    If EnRng.Row = 65535 Then Set EnRng = Src([A65536].End(xlUp).Row)
    Des.ClearContents
    With Range(StRng, EnRng).Offset(, 2)
      Des.Resize(.Rows.Count).Value = .Value
    End With
  End If
End Sub

Không có tí vòng lập nào tôi nghĩ chắc không đến nổi tệ
Ẹc... Ẹc...

 

[ndu96081631]

Bạn Boyxin có thể làm cho mình ở sheet 2 được không? và Bạn có thể lọc thêm cho mình ví dụ như cột địa chỉ và thêm 1 số cột nữa sau họ tên. Thanks

Sửa lại tí là xong ngay mà!

Sub Worksheet_Change(ByVal Target As Range)
  Dim Src As Range, Des As Range, StRng As Range, EnRng As Range
  On Error Resume Next
  If Target.Address = "$B$2" Then
    Er = Sheet1.[A65536].End(xlUp).Row
    Set Rng = Sheet1.Range("A7:E" & Er)
    Set Src = Rng.Offset(, 2).Resize(, 1)
    Set Des = [A7:E1000]
    Set StRng = Src(WorksheetFunction.Match([B2], Src, 0))
    Set EnRng = StRng.End(xlDown).Offset(-1)
    If EnRng.Row = 65535 Then Set EnRng = Src(Er)
    Des.ClearContents
    With Sheet1.Range(StRng, EnRng).Offset(, -2).Resize(, 5)
      Des.Resize(.Rows.Count, 5).Value = .Value
    End With
  End If
End Sub

 

[boyxin]

Bạn Boyxin có thể làm cho mình ở sheet 2 được không? và Bạn có thể lọc thêm cho mình ví dụ như cột địa chỉ và thêm 1 số cột nữa sau họ tên. Thanks

Một cách dùng công thức
​

 

[ndu96081631]

Code của Hoangdanh282vn ngay chổ:

WorksheetFunction.Min(SCell.End(xlDown).Row, ERow)

Hình như phải sửa lại thành:

WorksheetFunction.Min(SCell.End(xlDown).Offset(-1).Row

Thì mới đúng chứ nhỉ (nếu không kết quả dư 1 dòng)

 

[lucky999]

Một cách dùng công thức
​

Cảm ơn bạn đã giúp mình, tiện đây cho mình hỏi luôn muốn bổ sung thêm số hàng thì cần phải làm gì ở VD mới có mã hàng thứ 4. Thanks

 

[boyxin]

Cảm ơn bạn đã giúp mình, tiện đây cho mình hỏi luôn muốn bổ sung thêm số hàng thì cần phải làm gì ở VD mới có mã hàng thứ 4. Thanks

Ở sheet 2 chọn ô C1: vào Data\Validation... nhìn vào khung Source bạn sẽ thấy ngay vần đề mà bạn thắc mắc