Nhờ giúp chuyển từ sub lọc dữ liệu thành function

[ngocleasing]

Bác nào chuyển giúp cái thủ tục sau thành hàm đươc không ạ

Public Sub MyFilter()
Dim lngStart As Long, lngEnd As Long
lngStart = Range("E1").Value 'assume this is the start date
lngEnd = Range("E2").Value 'assume this is the end date
Range("C1:C13").AutoFilter field:=1, _
Criteria1:=">=" & lngStart, _
Operator:=xlAnd, _
Criteria2:="<=" & lngEnd
End Sub

https://vi.extendoffice.com/documents/excel/910-excel-filter-between-two-dates.html

 

[ptm0412]

Bác nào chuyển giúp cái thủ tục sau thành hàm đươc không ạ

Hàm Filter, công thức:
=FILTER(A2:C13,(C2:C13>=E1)*(C2:C13<=E2))

 

[hoangtuaotrang_hp_vn]

Bác nào chuyển giúp cái thủ tục sau thành hàm đươc không ạ

Public Sub MyFilter()
Dim lngStart As Long, lngEnd As Long
lngStart = Range("E1").Value 'assume this is the start date
lngEnd = Range("E2").Value 'assume this is the end date
Range("C1:C13").AutoFilter field:=1, _
Criteria1:=">=" & lngStart, _
Operator:=xlAnd, _
Criteria2:="<=" & lngEnd
End Sub

https://vi.extendoffice.com/documents/excel/910-excel-filter-between-two-dates.html

đổi mỗi chữ "Sub" thành chữ "Function" là OK

 

[ptm0412]

đổi mỗi chữ "Sub" thành chữ "Function" là OK

Rồi sử dụng hàm đó trên sheet như thế nào?

 

[ngocleasing]

đổi mỗi chữ "Sub" thành chữ "Function" là OK

Cảm ơn bác, nhưng nó còn liên quan đến nạp tham số vào hàm nữa mà

Bài đã được tự động gộp: 14/2/23

Hàm Filter, công thức:
=FILTER(A2:C13,(C2:C13>=E1)*(C2:C13<=E2

Hàm filter chỉ có trong excel 360 mà bác, em dùng excel 2019 ạ

 

[ptm0412]

Hàm filter chỉ có trong excel 360 mà bác, em dùng excel 2019 ạ

Nếu không có hàm Filter và đang xài 2019

Function MyFilter(DataRng As Range, StartD As Date, EndD As Date, DCol As Long)
Dim DataArr(), ResultArr(), RwsCount As Long, ColCount As Long
DataArr = DataRng.Value
RwsCount = UBound(DataArr, 1)
ColCount = UBound(DataArr, 2)
For i = 1 To RwsCount
    If DataArr(i, DCol) >= StartD And DataArr(i, DCol) <= EndD Then
        k = k + 1
        ReDim Preserve ResultArr(1 To ColCount, 1 To k)
        For j = 1 To ColCount
            ResultArr(j, k) = DataArr(i, j)
        Next
    End If
Next
MyFilter = Application.Transpose(ResultArr)
End Function

Dcol là thứ tự của cột chứa ngày.
H2 =myfilter(A2:C16,F1,F2,3)

 

[ngocleasing]

Nếu không có hàm Filter và đang xài 2019

Function MyFilter(DataRng As Range, StartD As Date, EndD As Date, DCol As Long)
Dim DataArr(), ResultArr(), RwsCount As Long, ColCount As Long
DataArr = DataRng.Value
RwsCount = UBound(DataArr, 1)
ColCount = UBound(DataArr, 2)
For i = 1 To RwsCount
    If DataArr(i, DCol) >= StartD And DataArr(i, DCol) <= EndD Then
        k = k + 1
        ReDim Preserve ResultArr(1 To ColCount, 1 To k)
        For j = 1 To ColCount
            ResultArr(j, k) = DataArr(i, j)
        Next
    End If
Next
MyFilter = Application.Transpose(ResultArr)
End Function

Dcol là thứ tự của cột chứa ngày.
H2 =myfilter(A2:C16,F1,F2,3)

View attachment 286495

Cảm ơn bác nhiều, nhưng nếu em dùng dấu Phẩy (,) để cách giữa các tham số hàm thì máy báo lỗi


Còn nếu em thay dấu Phẩy (,) bằng dấu Chấm phẩy ( thì kết quả chỉ ra không đúng bác ah

 

[ptm0412]

Còn nếu em thay dấu Phẩy (,) bằng dấu Chấm phẩy ( thì kết quả chỉ ra không đúng bác ah

Chả lẽ 2019 không ra được kết quả mảng?
Thử: tô khối H2:J12 gõ công thức rồi Ctrl shift Enter
Xài: H2 =Index(MyFilter($A$2:$C$12,$F$1,$F$2,3),Row(B1),Column(B1)), fill ngang và fill dọc đến khi lỗi thì ngưng

 

[ngocleasing]

Chả lẽ 2019 không ra được kết quả mảng?
Thử: tô khối H2:J12 gõ công thức rồi Ctrl shift Enter
Xài: H2 =Index(MyFilter($A$2:$C$12,$F$1,$F$2,3),Row(B1),Column(B1)), fill ngang và fill dọc đến khi lỗi thì ngưng

Nếu gõ vào dấu phẩu thì báo lỗi như sau bác ah


Còn nếu thay dấu phẩy bằng dấu chấm phẩy trong công thức và gõ xong ấn enter ctr shift, xong kéo ngang, kéo dọc thì có kết quả như sau bác ah

 

[ptm0412]

Nếu gõ vào dấu phẩu thì báo lỗi như sau bác ah
Còn nếu thay dấu phẩy bằng dấu chấm phẩy trong công thức và gõ xong ấn enter ctr shift, xong kéo ngang, kéo dọc thì có kết quả như sau bác ah

Bạn đừng bao giờ thử dấu phảy trên máy bạn nữa, ai đưa công thức cho bạn dấu phảy thì phải tự biết mà đổi, khỏi kêu ca.
Bạn đọc kỹ khi nào tôi nói Ctrl shift enter, khi nào không bảo. Và đọc cả chỗ "khi nào lỗi thì ngưng"
---
Sửa lại chút xíu:

H2 =Index(MyFilter($A$2:$C$12,$F$1,$F$2,3),Row(A1),Column(A1))

 

[ngocleasing]

Bạn đừng bao giờ thử dấu phảy trên máy bạn nữa, ai đưa công thức cho bạn dấu phảy thì phải tự biết mà đổi, khỏi kêu ca.
Bạn đọc kỹ khi nào tôi nói Ctrl shift enter, khi nào không bảo. Và đọc cả chỗ "khi nào lỗi thì ngưng"

Vâng có thể em chưa hiểu rõ ý bác lắm, nhưng em đang làm là bôi khối H2:J12, xong gõ công thức, tiếp đó là nhấn tổ hợp phím ctr shift enter, xong đặt chuột vào góc cuối của khối kéo ngang kéo dọc thì ra kết quả sau ạ

 

[ptm0412]

Vâng có thể em chưa hiểu rõ ý bác lắm, nhưng em đang làm là bôi khối H2:J12, xong gõ công thức, tiếp đó là nhấn tổ hợp phím ctr shift enter, xong đặt chuột vào góc cuối của khối kéo ngang kéo dọc thì ra kết quả sau ạ

Bạn đọc lại thật kỹ lần nữa. Phải làm 2 lần, 1 lần thử và 1 lần xài. Hai cái riêng rẽ xóa đi làm lại.
Sửa lại chút xíu:

Xài: H2 =Index(MyFilter($A$2:$C$12,$F$1,$F$2,3),Row(A1),Column(A1))

 

[ngocleasing]

Bạn đừng bao giờ thử dấu phảy trên máy bạn nữa, ai đưa công thức cho bạn dấu phảy thì phải tự biết mà đổi, khỏi kêu ca.
Bạn đọc kỹ khi nào tôi nói Ctrl shift enter, khi nào không bảo. Và đọc cả chỗ "khi nào lỗi thì ngưng"
---
Sửa lại chút xíu:

H2 =Index(MyFilter($A$2:$C$12,$F$1,$F$2,3),Row(A1),Column(A1))

Kết quả như sau bác ạ

 

[ngocmaipretty]

Kết quả như sau bác ạ

Nhìn hình thì thấy bạn không chịu đọc lại. Bác ấy viết rõ rằng: Làm 2 lần xóa đi làm lại chứ không phải làm 1 lần 2 bước.
Lần 1: tô khối, gõ công thức, ctrl shift enter. Xem kết quả.
Lần 2: tốt nhất là làm chỗ khác. Nếu làm tại H2 thì phải xóa kết quả lần 1 đi. Gõ công thức 1 ô, enter, không ctrl shift gì sất. Rồi mới fill ngang fill dọc.
Bác ấy viết đến 3 lần là quá kiên nhẫn rồi đó.

 

[ngocleasing]

Bạn đọc lại thật kỹ lần nữa. Phải làm 2 lần, 1 lần thử và 1 lần xài. Hai cái riêng rẽ xóa đi làm lại.
Sửa lại chút xíu:

Xài: H2 =Index(MyFilter($A$2:$C$12,$F$1,$F$2,3),Row(A1),Column(A1))

Kết quả lần thử:

Kết quả lần xài

Thế là cả hai lần đều ngon bác ạ. Cảm ơn bác nhiều, em muốn chút nữa giả sử em cần lọc ra cột D không phải là SG thì sửa cái code VBA trên như thế
nào bác nhỉ

 

[ngocmaipretty]

Thế là cả hai lần đều ngon bác ạ. Cảm ơn bác nhiều, em muốn chút nữa giả sử em cần lọc ra cột D không phải là SG thì sửa cái code VBA trên như thế
nào bác nhỉ

Không ai viết hàm chung được đâu. Lúc thì khác SG, lúc thì bằng HCM, lúc thì trong khoảng giữa 2 ngày, lúc thì trước ngày A, lúc thì sau ngày B. Mỗi trường hợp phải viết 1 hàm á hả?
Các trường hợp lung tung này mà không có hàm Filter của 365 thì phải dùng Advanced filter, VBA thì viết Sub, không dùng function.

 

[ngocleasing]

Không ai viết hàm chung được đâu. Lúc thì khác SG, lúc thì bằng HCM, lúc thì trong khoảng giữa 2 ngày, lúc thì trước ngày A, lúc thì sau ngày B. Mỗi trường hợp phải viết 1 hàm á hả?
Các trường hợp lung tung này mà không có hàm Filter của 365 thì phải dùng Advanced filter, VBA thì viết Sub, không dùng function.

Ý em là thêm 1 cột để loại 1 yếu tố, như trên thì cần loại yếu tố là SG chẳng hạn, còn yếu tố khác thế nào thì em sẽ tự sửa vào trong VBA mà. Còn không cần thay đổi gì thêm ạ

 

[ptm0412]

Ý em là thêm 1 cột để loại 1 yếu tố, như trên thì cần loại yếu tố là SG chẳng hạn, còn yếu tố khác thế nào thì em sẽ tự sửa vào trong VBA mà. Còn không cần thay đổi gì thêm ạ

Tôi không tin bạn tự sửa trong VBA được. Xài trên sheet còn lúng ta lúng túng, chuyển từ sub sang function thì không biết gì.

 

[ngocleasing]

Tôi không tin bạn tự sửa trong VBA được. Xài trên sheet còn lúng ta lúng túng, chuyển từ sub sang function thì không biết gì.

hehe, em tưởng chỉ cần sửa chữ SG thành HCM thui ạ, hay là bác cho cái chuẩn men luôn là vẫn cái hàm trên nhưng thêm 1 tham số loại 1 yếu tố trong cột D chẳng hạn!

 

[ngocmaipretty]

Ý em là thêm 1 cột để loại 1 yếu tố, như trên thì cần loại yếu tố là SG chẳng hạn, còn yếu tố khác thế nào thì em sẽ tự sửa vào trong VBA mà. Còn không cần thay đổi gì thêm ạ

Sub thì đơn giản thế này:

Sub AdvFilter()
    Range("A1:D16").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "M1:O2"), CopyToRange:=Range("Q1:T1"), Unique:=False
End Sub

Công thức M2 =">="&F1
N2 ="<="&F2
O2 gõ tay