Nhờ gúp đỡ lọc theo thời gian rồi copy

Liên hệ QC
V

vietlehoang

Thành viên mới
Tham gia
15/7/21
Bài viết
5
Được thích
2
Mình có fille dữ liệu cần lọc ngày theo thời gian nhập vào 2 ô G19, I19 trong Sheets menu mà không được nhờ cao thủ giúp
 

File đính kèm

  • loc ngay.xlsm
    406.2 KB · Đọc: 19
Sắp xếp theo thời gian sắp xếp theo bầu chọn
sheet Nhap_vh cột E ngày phát hiện đang là kiểu text không phải kiểu ngày. Bạn xử lý lại dữ liệu cột E thành kiểu dữ liệu ngày là được.
 
Upvote 0
vietlehoang đã viết:
Mình có fille dữ liệu cần lọc ngày theo thời gian nhập vào 2 ô G19, I19 trong Sheets menu mà không được nhờ cao thủ giúp
Nhấp chuột vào đây để mở rộng...
Bạn thử code dưới xem:
Mã: 
Option Explicit

'// Ham kiem tra xem ten sheet con ton tai trong file hay la khong
Public Function SheetExists(strSheetName As String, Optional wbWorkbook As Workbook) As Boolean
    If wbWorkbook Is Nothing Then Set wbWorkbook = ActiveWorkbook
    Dim obj As Object
    On Error GoTo HandleError
    Set obj = wbWorkbook.Sheets(strSheetName)
    SheetExists = True
    Exit Function
HandleError:
    SheetExists = False
End Function

Sub locNgay()

    '// Khai bao cac bien
    Dim book As Workbook, shNhapVH As Worksheet, shLoc As Worksheet, shName As String
    Dim rng As Range, rU As Range, fDate As Date, eDate As Date, r As Long
    
    Set book = ThisWorkbook                             '// Voi chinh file chay code
    Set shNhapVH = book.Worksheets("nhap_vh")           '// Gan sheet "nhap_vh" = shNhapVH
    
    '// Xac dinh dong cuoi trong sheet shNhapVH (sheet "nhap_vh")
    r = shNhapVH.Cells(shNhapVH.Rows.Count, "A").End(xlUp).Row
    If r < 7 Then '// Neu dong cuoi cung < 7
        '// Thong bao du lieu ban dau khong co
        MsgBox "Khong co du lieu", vbInformation + vbOKOnly
        Exit Sub '// Thoat thu tuc
    End If
    
    fDate = book.Worksheets("Menu").Range("G19") '// Tu ngay
    eDate = book.Worksheets("Menu").Range("I19") '// Den ngay
    
    '// Neu khong nhap ngay thang loc hoac ngay sau > ngay truoc
    If (fDate = 0) Or (eDate = 0) Or (fDate > eDate) Then
        '// Thong bao ngay thang nam co van de
        MsgBox "Kiem tra lai ngay thang", vbCritical + vbOKOnly
        Exit Sub '// Thoat thu tuc
    End If
        
    shName = "loc_ngay" '// gan chuoi "loc_ngay" vao bien shName
    
    '// kiem tra sheet co ten "loc_ngay" co ton tai trong file hay khong
    If SheetExists(shName, book) Then
        '// Neu dung la no ton tai thi gan sheet "loc_ngay" = shLoc
        Set shLoc = book.Worksheets(shName)
        Application.DisplayAlerts = False   '// tat thong bao hoi xoa sheet
        shLoc.Delete                        '// xoa sheet sheet "loc_ngay"
        Application.DisplayAlerts = True    '// bat lai thong bao (tra lai ban dau)
    End If
    
    '// copy sheet shNhapVH (sheet "nhap_vh") sang mot sheet moi thu tu cuoi cung tronf file
    shNhapVH.Copy after:=book.Worksheets(book.Worksheets.Count)
    '// gan sheet voi copy nay = shLoc va dat cho mot cai ten shName (="loc_ngay" da gan o tren)
    Set shLoc = ActiveSheet:    shLoc.Name = shName
    
    For Each rng In shLoc.Range("E7:E" & r) '// duye trong cot ngay tu dong 6 den dong cuoi cung
        '// neu gia tri tim duoc < ngay bat dau hoac > ngay sau thi ..
        If (rng.Value < fDate) Or (rng.Value) > eDate Then
            '// gan dong tim duoc vao biet rU, cu tim duoc gia tri  thoa man la gan het vao rU
            If rU Is Nothing Then Set rU = rng Else Set rU = Union(rU, rng)
        End If
    Next rng
    
    '// Kiem tra xem rU co ton tai (co gia tri khong thoa man dieu kien khong)
    If Not rU Is Nothing Then rU.EntireRow.Delete '// Neu thoa man thi xoa
    
    '// Thong bao ket thuc
    MsgBox "Da loc xong.", vbInformation + vbOKOnly
    
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Hoàng Nhật Phương đã viết:
Bạn thử code dưới xem:
Nhấp chuột vào đây để mở rộng...
Code kinh khủng quá. Cả 3 loại lọc chỉ cần 1 sub ngắn gọn như vầy:
PHP: 
Sub AdvFilter()
Sheet2.Range("A6:R378").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheet0.Range("I1:J2"), CopyToRange:=Sheet5.Range("A1:R1") _
        , Unique:=False
    Sheet5.Name = Sheet0.[I1].value
    Sheet5.Activate
End Sub

Sheet Menu chỉ cần như vầy:

1629364454391.png
 

File đính kèm

  • LocNgay-AdvancedFilter.xlsm
    386.1 KB · Đọc: 12
Lần chỉnh sửa cuối:
Upvote 0
Chỉ cần thay các tiêu đề ở Sheet Data giống tiêu đề ở sheet nhap_vh, với code Advanced Filter, thì mọi thứ trở nên rất đơn giản.
Bạn thử:
Mã: 
Sub Loc()
    Sheets("nhap_vh").[A6:R10000].AdvancedFilter 2, Sheets("nhap_vh").[B2:B3], Sheets("Data").[A1:I1]
    Sheets("Data").Select
End Sub
 

File đính kèm

  • loc ngay.xlsm
    407.7 KB · Đọc: 6
Upvote 0
Upvote 0
ptm0412 đã viết:
Code kinh khủng quá. Cả 3 loại lọc chỉ cần 1 sub ngắn gọn như vầy:
PHP: 
Sub AdvFilter()
Sheet2.Range("A6:R378").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheet0.Range("I1:J2"), CopyToRange:=Sheet5.Range("A1:R1") _
        , Unique:=False
    Sheet5.Name = Sheet0.[I1].value
    Sheet5.Activate
End Sub

Sheet Menu chỉ cần như vầy:

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

Ồ thì ra là lọc 1 trong 3 loại ngày , con nhìn code của bạn ấy ở bài 1 con thấy mỗi cột 5 con tưởng chỉ lọc cột ngày này.
Nếu 3 loại ngày thì thiết kế thêm một ô G21 trong sheet Menu như ảnh bên dưới, ô này để chọn ngày cần lọc:

1629369847063.png

Code lọc theo ngày lựa chọn trong ô G21:
Mã: 
Option Explicit

'// Ham kiem tra xem ten sheet con ton tai trong file hay la khong
Public Function SheetExists(strSheetName As String, Optional wbWorkbook As Workbook) As Boolean
    If wbWorkbook Is Nothing Then Set wbWorkbook = ActiveWorkbook
    Dim obj As Object
    On Error GoTo HandleError
    Set obj = wbWorkbook.Sheets(strSheetName)
    SheetExists = True
    Exit Function
HandleError:
    SheetExists = False
End Function

Public Sub locNgay()

    '// Khai bao cac bien
    Dim book As Workbook, shNhapVH As Worksheet, shLoc As Worksheet, rng As Range, rU As Range
    Dim fDate As Date, eDate As Date, r As Long, shName As String, sNgayLoc As String, iCol As Integer
    
    Set book = ThisWorkbook                         '// Voi chinh file chay code
    Set shNhapVH = book.Worksheets("nhap_vh")       '// Gan sheet "nhap_vh" = shNhapVH
    
    '// Xac dinh dong cuoi trong sheet shNhapVH (sheet "nhap_vh")
    r = shNhapVH.Cells(shNhapVH.Rows.Count, "A").End(xlUp).Row
    If r < 7 Then '// Neu dong cuoi cung < 7
        '// Thong bao du lieu ban dau khong co
        MsgBox "Khong co du lieu", vbInformation + vbOKOnly
        Exit Sub '// Thoat thu tuc
    End If
    
    '// Gan cac gia tri trong shete Menu vao cac bien
    fDate = book.Worksheets("Menu").Range("G19")    '// Tu ngay
    eDate = book.Worksheets("Menu").Range("I19")    '// Den ngay
    sNgayLoc = book.Worksheets("Menu").Range("G21") '// Cot ngay can loc
    
    On Error Resume Next    '// Bat loi neu khong tim thay ngay can loc
    '// Kiem cot vi tri cot ngay can loc xem la cot dung tu may
    iCol = Application.Match(sNgayLoc, shNhapVH.Range("A6:R6"), 0)
    On Error GoTo 0         '// xoa bat loi
    
    If iCol = 0 Then        '// Neu khong tim thay vi tri ngay can loc
        '// Thong bao khong thay ngay loc
        MsgBox "Khong tim thay ngay loc", vbInformation + vbOKOnly
        Exit Sub '// Thoat thu tuc
    End If
    '// Neu khong nhap ngay thang loc hoac ngay sau > ngay truoc
    If (fDate = 0) Or (eDate = 0) Or (fDate > eDate) Then
        '// Thong bao ngay thang nam co van de
        MsgBox "Kiem tra lai ngay thang", vbCritical + vbOKOnly
        Exit Sub '// Thoat thu tuc
    End If
    shName = "loc_ngay" '// gan chuoi "loc_ngay" vao bien shName
    '// kiem tra sheet co ten "loc_ngay" co ton tai trong file hay khong
    If SheetExists(shName, book) Then
        '// Neu dung la no ton tai thi gan sheet "loc_ngay" = shLoc
        Set shLoc = book.Worksheets(shName)
        Application.DisplayAlerts = False   '// tat thong bao hoi xoa sheet
        shLoc.Delete                        '// xoa sheet sheet "loc_ngay"
        Application.DisplayAlerts = True    '// bat lai thong bao (tra lai ban dau)
    End If
    
    '// copy sheet shNhapVH (sheet "nhap_vh") sang mot sheet moi thu tu cuoi cung tronf file
    shNhapVH.Copy after:=book.Worksheets(book.Worksheets.Count)
    '// gan sheet voi copy nay = shLoc va dat cho mot cai ten shName (="loc_ngay" da gan o tren)
    Set shLoc = ActiveSheet:    shLoc.Name = shName
    '// duyet trong cot ngay tu dong 6 den dong cuoi cung
    For Each rng In shLoc.Range("A7:A" & r).Offset(, iCol - 1)
        '// neu gia tri tim duoc < ngay bat dau hoac > ngay sau thi ..
        If (rng.Value < fDate) Or (rng.Value > eDate) Then
            '// gan dong tim duoc vao biet rU, cu tim duoc gia tri  thoa man la gan het vao rU
            If rU Is Nothing Then Set rU = rng Else Set rU = Union(rU, rng)
        End If
    Next rng
    '// Kiem tra xem rU co ton tai (co gia tri khong thoa man dieu kien khong)
    If Not rU Is Nothing Then rU.EntireRow.Delete '// Neu thoa man thi xoa
    '// Thong bao ket thuc
    MsgBox "Da loc xong ", vbInformation + vbOKOnly

End Sub
 

File đính kèm

  • loc ngay.xlsm
    302.9 KB · Đọc: 10
Upvote 0
Code này đọc choáng luôn í bạn. Tôi nghĩ advanced filter bài này là hợp lý, ngắn gọn, dễ hiểu.
 
Upvote 0
Hoàng Nhật Phương đã viết:
Ồ thì ra là lọc 1 trong 3 loại ngày , con nhìn code của bạn ấy ở bài 1 con thấy mỗi cột 5 con tưởng chỉ lọc cột ngày này.
Nếu 3 loại ngày thì thiết kế thêm một ô G21 trong sheet Menu như ảnh bên dưới, ô này để chọn ngày cần lọc:
Nhấp chuột vào đây để mở rộng...
File bài 1 có 3 nút nhấn, chạy 3 sub khủng để lọc 3 kiểu.
Combobox hay option button hay gì cũng được, chỉ cần 1 vài câu lệnh trong đó có advanced filter là xong như bài #5, sao cứ phải code khủng như vậy chứ. Lại còn xoá sheet tạo sheet cho mất công kiểm tra sự tồn tại.
 
Upvote 0
ptm0412 đã viết:
File bài 1 có 3 nút nhấn, chạy 3 sub khủng để lọc 3 kiểu.
Combobox hay option button hay gì cũng được, chỉ cần 1 vài câu lệnh trong đó có advanced filter là xong như bài #5, sao cứ phải code khủng như vậy chứ. Lại còn xoá sheet tạo sheet cho mất công kiểm tra sự tồn tại.
Nhấp chuột vào đây để mở rộng...

Ơ con đâu có biết đâu ạ.
Con thấy Bạn ấy có nói là chương trình chạy tốt và copy sang sheet mới như ở đây nên con mới viết theo ý tưởng của Bạn ấy,

1629381056601.png

Chắc tại code nhiều ghi chú quá trời trông như viết văn nên chú Mỹ không quen chứ khủng khiếp đến đâu ạ :"'
 
Upvote 0
Hoàng Nhật Phương đã viết:
Chắc tại code nhiều ghi chú quá trời trông như viết văn nên chú Mỹ không quen chứ khủng khiếp đến đâu ạ :"'
Nhấp chuột vào đây để mở rộng...
20 câu lệnh so với 2 câu lệnh là khủng. Với vấn đề phức tạp cần làm cho đơn giản bớt đi, tư duy thoáng đi, cộng với tư duy đập đi xây lại cho nhanh.
 
Upvote 0
Thay đổi vùng điều kiện chút, với các option chọn,
Khác về vùng điều kiện so với sư phụ @ptm0412 , còn bản chất thì giống nhau.
 

File đính kèm

  • loc ngay.xlsm
    408.1 KB · Đọc: 7
Upvote 0
Hoàng Nhật Phương đã viết:
Ồ thì ra là lọc 1 trong 3 loại ngày , con nhìn code của bạn ấy ở bài 1 con thấy mỗi cột 5 con tưởng chỉ lọc cột ngày này.
Nếu 3 loại ngày thì thiết kế thêm một ô G21 trong sheet Menu như ảnh bên dưới, ô này để chọn ngày cần lọc:

View attachment 264356

Code lọc theo ngày lựa chọn trong ô G21:
Mã: 
Option Explicit

'// Ham kiem tra xem ten sheet con ton tai trong file hay la khong
Public Function SheetExists(strSheetName As String, Optional wbWorkbook As Workbook) As Boolean
    If wbWorkbook Is Nothing Then Set wbWorkbook = ActiveWorkbook
    Dim obj As Object
    On Error GoTo HandleError
    Set obj = wbWorkbook.Sheets(strSheetName)
    SheetExists = True
    Exit Function
HandleError:
    SheetExists = False
End Function

Public Sub locNgay()

    '// Khai bao cac bien
    Dim book As Workbook, shNhapVH As Worksheet, shLoc As Worksheet, rng As Range, rU As Range
    Dim fDate As Date, eDate As Date, r As Long, shName As String, sNgayLoc As String, iCol As Integer
   
    Set book = ThisWorkbook                         '// Voi chinh file chay code
    Set shNhapVH = book.Worksheets("nhap_vh")       '// Gan sheet "nhap_vh" = shNhapVH
   
    '// Xac dinh dong cuoi trong sheet shNhapVH (sheet "nhap_vh")
    r = shNhapVH.Cells(shNhapVH.Rows.Count, "A").End(xlUp).Row
    If r < 7 Then '// Neu dong cuoi cung < 7
        '// Thong bao du lieu ban dau khong co
        MsgBox "Khong co du lieu", vbInformation + vbOKOnly
        Exit Sub '// Thoat thu tuc
    End If
   
    '// Gan cac gia tri trong shete Menu vao cac bien
    fDate = book.Worksheets("Menu").Range("G19")    '// Tu ngay
    eDate = book.Worksheets("Menu").Range("I19")    '// Den ngay
    sNgayLoc = book.Worksheets("Menu").Range("G21") '// Cot ngay can loc
   
    On Error Resume Next    '// Bat loi neu khong tim thay ngay can loc
    '// Kiem cot vi tri cot ngay can loc xem la cot dung tu may
    iCol = Application.Match(sNgayLoc, shNhapVH.Range("A6:R6"), 0)
    On Error GoTo 0         '// xoa bat loi
   
    If iCol = 0 Then        '// Neu khong tim thay vi tri ngay can loc
        '// Thong bao khong thay ngay loc
        MsgBox "Khong tim thay ngay loc", vbInformation + vbOKOnly
        Exit Sub '// Thoat thu tuc
    End If
    '// Neu khong nhap ngay thang loc hoac ngay sau > ngay truoc
    If (fDate = 0) Or (eDate = 0) Or (fDate > eDate) Then
        '// Thong bao ngay thang nam co van de
        MsgBox "Kiem tra lai ngay thang", vbCritical + vbOKOnly
        Exit Sub '// Thoat thu tuc
    End If
    shName = "loc_ngay" '// gan chuoi "loc_ngay" vao bien shName
    '// kiem tra sheet co ten "loc_ngay" co ton tai trong file hay khong
    If SheetExists(shName, book) Then
        '// Neu dung la no ton tai thi gan sheet "loc_ngay" = shLoc
        Set shLoc = book.Worksheets(shName)
        Application.DisplayAlerts = False   '// tat thong bao hoi xoa sheet
        shLoc.Delete                        '// xoa sheet sheet "loc_ngay"
        Application.DisplayAlerts = True    '// bat lai thong bao (tra lai ban dau)
    End If
   
    '// copy sheet shNhapVH (sheet "nhap_vh") sang mot sheet moi thu tu cuoi cung tronf file
    shNhapVH.Copy after:=book.Worksheets(book.Worksheets.Count)
    '// gan sheet voi copy nay = shLoc va dat cho mot cai ten shName (="loc_ngay" da gan o tren)
    Set shLoc = ActiveSheet:    shLoc.Name = shName
    '// duyet trong cot ngay tu dong 6 den dong cuoi cung
    For Each rng In shLoc.Range("A7:A" & r).Offset(, iCol - 1)
        '// neu gia tri tim duoc < ngay bat dau hoac > ngay sau thi ..
        If (rng.Value < fDate) Or (rng.Value > eDate) Then
            '// gan dong tim duoc vao biet rU, cu tim duoc gia tri  thoa man la gan het vao rU
            If rU Is Nothing Then Set rU = rng Else Set rU = Union(rU, rng)
        End If
    Next rng
    '// Kiem tra xem rU co ton tai (co gia tri khong thoa man dieu kien khong)
    If Not rU Is Nothing Then rU.EntireRow.Delete '// Neu thoa man thi xoa
    '// Thong bao ket thuc
    MsgBox "Da loc xong ", vbInformation + vbOKOnly

End Sub
Nhấp chuột vào đây để mở rộng...
Hoàng Nhật Phương đã viết:
Ơ con đâu có biết đâu ạ.
Con thấy Bạn ấy có nói là chương trình chạy tốt và copy sang sheet mới như ở đây nên con mới viết theo ý tưởng của Bạn ấy,

View attachment 264372

Chắc tại code nhiều ghi chú quá trời trông như viết văn nên chú Mỹ không quen chứ khủng khiếp đến đâu ạ :"'
Nhấp chuột vào đây để mở rộng...
Thank ban, đã giải quyết được vấn đề
 
Upvote 0
Cá ngừ F1 đã viết:
Thay đổi vùng điều kiện chút, với các option chọn,
Khác về vùng điều kiện so với sư phụ @ptm0412 , còn bản chất thì giống nhau.
Nhấp chuột vào đây để mở rộng...
Công thức vùng điều kiện khủng quá
=IF($N$3=1,AND(nhap_vh!$E7>=Menu!$G$19,nhap_vh!$E7<=Menu!$I$19),IF(Menu!$N$3=2,AND(nhap_vh!$J7>=Menu!$G$19,nhap_vh!$J7<=Menu!$I$19),IF(Menu!$N$3=3,AND(nhap_vh!$O7>=Menu!$G$19,nhap_vh!$O7<=Menu!$I$19))))

"Bản chất giống nhau", nhưng tư duy khác nhau, Khác ở chỗ phức tạp hoá hay đơn giản hoá.
 
Upvote 0
ptm0412 đã viết:
Công thức vùng điều kiện khủng quá
=IF($N$3=1,AND(nhap_vh!$E7>=Menu!$G$19,nhap_vh!$E7<=Menu!$I$19),IF(Menu!$N$3=2,AND(nhap_vh!$J7>=Menu!$G$19,nhap_vh!$J7<=Menu!$I$19),IF(Menu!$N$3=3,AND(nhap_vh!$O7>=Menu!$G$19,nhap_vh!$O7<=Menu!$I$19))))

"Bản chất giống nhau", nhưng tư duy khác nhau, Khác ở chỗ phức tạp hoá hay đơn giản hoá.
Nhấp chuột vào đây để mở rộng...
Vâng, vùng điều kiện của sư phụ chuẩn quá rồi.
Em ko còn cách nào khác đành chuyển lọc bằng công thức zậy !!!!
 
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

B
  • Question
Chuyển đổi dữ liệu sạng dạng mảng
Trả lời
2
Đọc
63
HieuCD
H
LuuAnh980
  • Question
Code lấy dữ liệu từ 3 file con.
Trả lời
11
Đọc
151
ho van luong
H
S
Nhờ giúp đỡ code in toàn bộ danh sách có điều kiện
Trả lời
6
Đọc
134
Hoàng Tuấn 868
H
S
  • Question
Không lấy đủ dữ liệu bằng kết nối ADO
Trả lời
0
Đọc
57
shnhatha221108
S
T
Không hiện dữ liệu ở ô công thức
Trả lời
3
Đọc
70
thien-16
T
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom