Trích Lọc dữ liệu với Macro

HTN033 · 15/10/19

Chào Tất cả Mọi Người,

Do công việc hàng tuần lập đi lặp lại và mất nhiều thời gian. nên nhờ mọi người giúp mình tạo code để thuận tiện và nhanh hơn nên mọi người xem và giúp đở cảm ơn mọi người.

Nội dung :
_ sheet Data là nguồn dữ liệu
_ Sheet Filter là kết quả.
==> ở sheet Filter : Cells B1, E1, H1, K1, N1, Q1 nhập ngày tháng vào thì nó lấy bên sheet Data.

Nhất Phong. Cảm ơn tất cả mọi người

HTN033 · 15/10/19

emcute đã viết:
Bạn tìm hiểu Pivot Table sẽ giải quyết được vấn đề của bạn...

Chào bạn,

Pivot table mình đang dùng nhưng mình muốn show ra như thế để dễ control. vì pivot table phải select tùng cái

Nhất Phong. Cảm ơn mọi người

Ba Tê · 15/10/19

HTN033 đã viết:
Chào bạn,

Pivot table mình đang dùng nhưng mình muốn show ra như thế để dễ control. vì pivot table phải select tùng cái

Nhất Phong. Cảm ơn mọi người

"Nhất Phong" là gì vậy bạn?

HTN033 · 15/10/19

emcute đã viết:
Sum of total Column Labels
Row Labels
14-Oct
15-Oct
16-Oct
17-Oct
18-Oct
19-Oct
Grand Total
ASV
24.95
2.38
27.33
BJV
12.21
61.41
73.62
CCV
2.95
11.82
3.22
0.52
18.51
CVT
98.92
12.48
19.04
130.44
DDV
18.22
33.69
0.1
52.01
DGV
4.47
7.51
1.66
13.64
EA4
1.23
25.61
9.74
36.49
13.53
86.6
EAV
3.82
2.64
18.99
25.45
EDV
1.97
0.49
100.14
102.6
EEO
101.41
93.76
29.6
224.77
EGN
0.12
70.89
71.01
EOL
7.87
138.39
12.3
45.45
204.01
ESV
18.11
10.92
29.03
EVT
4.5
55.39
13.67
0.42
3.8
77.78
FVN
379.11
101.61
480.72
HSV
1.97
1.97
HTV
3.91
3.78
7.69
NIV
433.79
88.24
37.43
70.74
630.2
NVC
22.42
63.68
86.53
88.01
260.64
NYV
3.51
3.51
PRE
65.95
3.7
69.65
QVE
2.53
113.46
0.03
116.02
SIV
33.74
542.26
156.38
0.25
23.39
756.02
SVV
5.451
5.451
TMV
30.16
59.32
24.62
0.48
114.58
USV
0.02
17.67
2.25
19.94
V2
105.71
202.76
252.33
171.74
134.86
40.7
908.1
VE
205.38
51.15
88.75
217.92
1274.01
1837.21
VF
22.82
246.25
157.72
878.49
1305.28
VG
81
118.78
36.57
236.35
VH
84.19
154.74
189.85
151.82
175.35
438.53
1194.48
VJ
192.18
91.16
278.14
360.24
926.11
284.34
2132.17
VL
172.46
95.74
148.1
99.87
78.83
112.18
707.18
VM
244.72
2.65
20.08
657.99
925.44
VO
142.69
118.04
30.2
5.52
183.82
525.9
1006.17
VP
102.27
144.5
344.35
85.77
286.74
65.95
1029.58
VT
860.44
1347.79
218.74
77.58
219.76
958.98
3683.29
VW
126.03
105.12
334.72
77.15
252.88
512.36
1408.26
VX
58.08
2.83
2.09
70.64
396.32
529.96
VY
110.05
14.71
178
239.85
471.63
193.34
1207.58
XV
37.75
37.75
Grand Total
2505.85
4626.691
2820.3
2014.13
4583.27
5201.75
21751.991

Chào bạn,
Thực tế mình làm trước giờ giống bạn nhưng mình muốn những những ngày không có code thì không show ra. do hiện tại nhìn không logic lắm

cảm ơn bạn

Bài đã được tự động gộp: 15/10/19

Ba Tê đã viết:
"Nhất Phong" là gì vậy bạn?

cảm ơn bạn rất nhiều

snow25 · 15/10/19

HTN033 đã viết:
Chào Tất cả Mọi Người,

Do công việc hàng tuần lập đi lặp lại và mất nhiều thời gian. nên nhờ mọi người giúp mình tạo code để thuận tiện và nhanh hơn nên mọi người xem và giúp đở cảm ơn mọi người.

Nội dung :
_ sheet Data là nguồn dữ liệu
_ Sheet Filter là kết quả.
==> ở sheet Filter : Cells B1, E1, H1, K1, N1, Q1 nhập ngày tháng vào thì nó lấy bên sheet Data.

Nhất Phong. Cảm ơn tất cả mọi người

Thử code.

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
    Dim lr As Long, arr, kq, a As Long, ngay As Long, dk As Long, i As Long, tong As Double
    If Not Intersect(Target, Range("B1,E1,H1,K1,N1,Q1")) Is Nothing Then
       If IsDate(Target.Value) Then
          ngay = Target.Value2
          lr = Sheets("data").Range("A" & Rows.Count).End(xlUp).Row
          If lr > 1 Then
             arr = Sheets("data").Range("A2:C" & lr).Value2
             ReDim kq(1 To UBound(arr), 1 To 2)
             For i = 1 To UBound(arr)
                 dk = arr(i, 1)
                 If dk = ngay Then
                    a = a + 1
                    kq(a, 1) = arr(i, 2)
                    kq(a, 2) = arr(i, 3)
                    tong = tong + arr(i, 3)
                 End If
             Next i
             a = a + 1
             kq(a, 1) = "Total"
             kq(a, 2) = tong
             lr = Target.End(xlDown).Row
             If lr > 2 Then Target.Offset(2).Resize(lr, 2).Clear
             If a Then
                Target.Offset(2).Resize(a, 2).Value = kq
                Target.Offset(2).Resize(a, 2).Borders.LineStyle = 1
             End If
         End If
     End If
   End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

nguyenthuy13388 · 15/10/19

Thêm 1 lựa chọn nữa cho bạn

Code cho sheets("Filter") như sau:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Long
Dim Sh As Worksheet, Rng As Range, arr As Range

 If Not Intersect(Target, Range("B1,E1,H1,K1,N1,Q1")) Is Nothing Then
    Target.Offset(2).Resize(10000, 2).ClearContents
    Set Sh = Sheets("Data")
    Set arr = Sh.Range("A2:A" & Sh.Range("A50000").End(xlUp).Row)
    For Each Rng In arr
        If Rng.Value = Target.Value Then
            lr = Target.End(xlDown).Row
            Target.Offset(lr).Value = Rng.Offset(, 1).Value
            Target.Offset(lr, 1).Value = Rng.Offset(, 2).Value
        End If
    Next
 End If

End Sub

khanhnguyen113 · 15/10/19

Vậy được chưa bạn

HTN033 · 15/10/19

HTN033 đã viết:
Chào bạn,
Thực tế mình làm trước giờ giống bạn nhưng mình muốn những những ngày không có code thì không show ra. do hiện tại nhìn không logic lắm

cảm ơn bạn

Bài đã được tự động gộp: 15/10/19

cảm ơn bạn rất nhiều

Chào bạn,

hiện tại mình vừa chèn thêm 2 côt" Ma Hang & Ma San Pham " trong sheet data vì vậy kết quả sheet Filter cũng thêm 2 cột, nhờ bạn giúp chỉnh lại code giúp.

Cảm ơn rất nhiều. Nhất Phong

phulien1902 · 15/10/19

HTN033 đã viết:
Chào bạn,

hiện tại mình vừa chèn thêm 2 côt" Ma Hang & Ma San Pham " trong sheet data vì vậy kết quả sheet Filter cũng thêm 2 cột, nhờ bạn giúp chỉnh lại code giúp.

Cảm ơn rất nhiều. Nhất Phong

Mượn Code bài #8, chỉnh sửa 1 chút:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lr As Long
    Dim Sh As Worksheet, Rng As Range, arr As Range
    If Not Intersect(Target, Range("B1,G1,L1,Q1,V1,AA1")) Is Nothing Then
        Target.Offset(2).Resize(10000, 4).ClearContents
        Set Sh = Sheets("Data")
        Set arr = Sh.Range("A2:A" & Sh.Range("A50000").End(xlUp).Row)
        For Each Rng In arr
            If Rng.Value = Target.Value Then
                lr = Target.End(xlDown).Row
                Target.Offset(lr).Value = Rng.Offset(, 1).Value
                Target.Offset(lr, 1).Value = Rng.Offset(, 2).Value
                Target.Offset(lr, 2).Value = Rng.Offset(, 3).Value
                Target.Offset(lr, 3).Value = Rng.Offset(, 4).Value
            End If
        Next
    End If
End Sub

Ba Tê · 15/10/19

HTN033 đã viết:
Chào bạn,

hiện tại mình vừa chèn thêm 2 côt" Ma Hang & Ma San Pham " trong sheet data vì vậy kết quả sheet Filter cũng thêm 2 cột, nhờ bạn giúp chỉnh lại code giúp.

Cảm ơn rất nhiều. Nhất Phong

Chẳng hiểu muốn nói với ai.
Từ đầu sao không đưa dữ liệu đầy đủ, làm rồi lại chèn thêm?

nguyenthuy13388 · 16/10/19

phulien1902 đã viết:

Mượn Code bài #8, chỉnh sửa 1 chút:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lr As Long
    Dim Sh As Worksheet, Rng As Range, arr As Range
    If Not Intersect(Target, Range("B1,G1,L1,Q1,V1,AA1")) Is Nothing Then
        Target.Offset(2).Resize(10000, 4).ClearContents
        Set Sh = Sheets("Data")
        Set arr = Sh.Range("A2:A" & Sh.Range("A50000").End(xlUp).Row)
        For Each Rng In arr
            If Rng.Value = Target.Value Then
                lr = Target.End(xlDown).Row
                Target.Offset(lr).Value = Rng.Offset(, 1).Value
                Target.Offset(lr, 1).Value = Rng.Offset(, 2).Value
                Target.Offset(lr, 2).Value = Rng.Offset(, 3).Value
                Target.Offset(lr, 3).Value = Rng.Offset(, 4).Value
            End If
        Next
    End If
End Sub

Mình nghĩ ý chủ thớt là như code dưới đây,
Phiền chủ thớt kiểm tra lại kết quả xem chính xác chưa nhé:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Long, j As Long, a As Long, Str As String, Str1 As String
Dim Sh As Worksheet, Rng As Range, arr As Range

If Not Intersect(Target, Range("B1,G1,L1,Q1,V1,AA1")) Is Nothing Then
    Target.Offset(2).Resize(10000, 4).ClearContents
    Set Sh = Sheets("Data")
    Set arr = Sh.Range("A2:A" & Sh.Range("A50000").End(xlUp).Row)
    For Each Rng In arr
        If Rng.Value = Target.Value Then
            If Len(Rng.Offset(, 1).Value) < 3 Then
                Str = Rng.Offset(, 1).Value & ","
            Else
                Str = Rng.Offset(, 1).Value
            End If
            If InStr(Str1, Str) = 0 Then
                Str1 = Str1 & Str
                lr = Target.End(xlDown).Row
                Target.Offset(lr).Value = Rng.Offset(, 1).Value
            End If
                With WorksheetFunction
                    j = .CountIfs(arr, Target, arr.Offset(, 1), Target.Offset(lr))
                    a = Rng.Row
                    If a > j Then
                        Target.Offset(lr, 1).Value = "=SUMPRODUCT(1/COUNTIF('Data'!C" & a - j + 1 & ":C" & a & ",'Data'!C" & a - j + 1 & ":C" & a & "))"
                        Target.Offset(lr, 2).Value = "=SUMPRODUCT(1/COUNTIF(Data!D" & a - j + 1 & ":D" & a & ",Data!D" & a - j + 1 & ":D" & a & "))"
                    End If
                    Target.Offset(lr, 3).Value = .SumIfs(arr.Offset(, 4), arr, Target, arr.Offset(, 1), Target.Offset(lr))
                End With
        End If
    Next
End If
End Sub

phulien1902 · 16/10/19

nguyenthuy13388 đã viết:

Mình nghĩ ý chủ thớt là như code dưới đây,
Phiền chủ thớt kiểm tra lại kết quả xem chính xác chưa nhé:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Long, j As Long, a As Long, Str As String, Str1 As String
Dim Sh As Worksheet, Rng As Range, arr As Range

If Not Intersect(Target, Range("B1,G1,L1,Q1,V1,AA1")) Is Nothing Then
    Target.Offset(2).Resize(10000, 4).ClearContents
    Set Sh = Sheets("Data")
    Set arr = Sh.Range("A2:A" & Sh.Range("A50000").End(xlUp).Row)
    For Each Rng In arr
        If Rng.Value = Target.Value Then
            If Len(Rng.Offset(, 1).Value) < 3 Then
                Str = Rng.Offset(, 1).Value & ","
            Else
                Str = Rng.Offset(, 1).Value
            End If
            If InStr(Str1, Str) = 0 Then
                Str1 = Str1 & Str
                lr = Target.End(xlDown).Row
                Target.Offset(lr).Value = Rng.Offset(, 1).Value
            End If
                With WorksheetFunction
                    j = .CountIfs(arr, Target, arr.Offset(, 1), Target.Offset(lr))
                    a = Rng.Row
                    If a > j Then
                        Target.Offset(lr, 1).Value = "=SUMPRODUCT(1/COUNTIF('Data'!C" & a - j + 1 & ":C" & a & ",'Data'!C" & a - j + 1 & ":C" & a & "))"
                        Target.Offset(lr, 2).Value = "=SUMPRODUCT(1/COUNTIF(Data!D" & a - j + 1 & ":D" & a & ",Data!D" & a - j + 1 & ":D" & a & "))"
                    End If
                    Target.Offset(lr, 3).Value = .SumIfs(arr.Offset(, 4), arr, Target, arr.Offset(, 1), Target.Offset(lr))
                End With
        End If
    Next
End If
End Sub

À! tôi cũng không để ý kỹ kết quả của chủ Topic, lọc và cộng dồn.
Code của bạn đúng rồi, có điều cho kết quả hơi chậm?

HTN033 · 16/10/19

nguyenthuy13388 đã viết:

Mình nghĩ ý chủ thớt là như code dưới đây,
Phiền chủ thớt kiểm tra lại kết quả xem chính xác chưa nhé:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Long, j As Long, a As Long, Str As String, Str1 As String
Dim Sh As Worksheet, Rng As Range, arr As Range

If Not Intersect(Target, Range("B1,G1,L1,Q1,V1,AA1")) Is Nothing Then
    Target.Offset(2).Resize(10000, 4).ClearContents
    Set Sh = Sheets("Data")
    Set arr = Sh.Range("A2:A" & Sh.Range("A50000").End(xlUp).Row)
    For Each Rng In arr
        If Rng.Value = Target.Value Then
            If Len(Rng.Offset(, 1).Value) < 3 Then
                Str = Rng.Offset(, 1).Value & ","
            Else
                Str = Rng.Offset(, 1).Value
            End If
            If InStr(Str1, Str) = 0 Then
                Str1 = Str1 & Str
                lr = Target.End(xlDown).Row
                Target.Offset(lr).Value = Rng.Offset(, 1).Value
            End If
                With WorksheetFunction
                    j = .CountIfs(arr, Target, arr.Offset(, 1), Target.Offset(lr))
                    a = Rng.Row
                    If a > j Then
                        Target.Offset(lr, 1).Value = "=SUMPRODUCT(1/COUNTIF('Data'!C" & a - j + 1 & ":C" & a & ",'Data'!C" & a - j + 1 & ":C" & a & "))"
                        Target.Offset(lr, 2).Value = "=SUMPRODUCT(1/COUNTIF(Data!D" & a - j + 1 & ":D" & a & ",Data!D" & a - j + 1 & ":D" & a & "))"
                    End If
                    Target.Offset(lr, 3).Value = .SumIfs(arr.Offset(, 4), arr, Target, arr.Offset(, 1), Target.Offset(lr))
                End With
        End If
    Next
End If
End Sub

Chào Nguyen Thuy,

bạn có thể ktra lại đoạn code này không:" If Not Intersect(Target, Range("B1,G1,L1,Q1,V1,AA1")) Is Nothing Then"
nó báo lổi không thể chạy được

Nhất Phong. Thanks

Bài đã được tự động gộp: 16/10/19

Ba Tê đã viết:
Chẳng hiểu muốn nói với ai.
Từ đầu sao không đưa dữ liệu đầy đủ, làm rồi lại chèn thêm?

Chào Anh Ba Tê,

rất xin lổi vì mình đã làm phiền anh, nhưng anh có thể kiểm tra và hổ trợ giúp được không.

Cảm ơn. Nhat Phong

nguyenthuy13388 · 16/10/19

HTN033 đã viết:
Chào Nguyen Thuy,

bạn có thể ktra lại đoạn code này không:" If Not Intersect(Target, Range("B1,G1,L1,Q1,V1,AA1")) Is Nothing Then"
nó báo lổi không thể chạy được

Xem file thì sẽ rõ, bạn chỉ cần thay đổi giá trị tại các cells ("B1,G1,L1,Q1,V1,AA1") thì code sẽ tự chạy

Bài đã được tự động gộp: 16/10/19

phulien1902 đã viết:
À! tôi cũng không để ý kỹ kết quả của chủ Topic, lọc và cộng dồn.
Code của bạn đúng rồi, có điều cho kết quả hơi chậm?

Mình đã nói từ đầu đó chỉ là 1 lựa chọn cho chủ thớt thôi, muốn nhanh thì dùng mảng thôi

1convit789 · 16/10/19

HTN033 đã viết:
Chào Tất cả Mọi Người,

Do công việc hàng tuần lập đi lặp lại và mất nhiều thời gian. nên nhờ mọi người giúp mình tạo code để thuận tiện và nhanh hơn nên mọi người xem và giúp đở cảm ơn mọi người.

Nội dung :
_ sheet Data là nguồn dữ liệu
_ Sheet Filter là kết quả.
==> ở sheet Filter : Cells B1, E1, H1, K1, N1, Q1 nhập ngày tháng vào thì nó lấy bên sheet Data.

Nhất Phong. Cảm ơn tất cả mọi người

Ba Tê · 16/10/19

HTN033 đã viết:
Chào Anh Ba Tê,

rất xin lổi vì mình đã làm phiền anh, nhưng anh có thể kiểm tra và hổ trợ giúp được không.

Đầu câu nhớ viết Hoa.
Chú ý chính tả "lổi", "hổ trợ".

Bài đã được tự động gộp: 16/10/19

@1convit789
1/ Bạn đang chen ngang vào topic của người khác mà nội dung không như chủ đề topic.
2/ Bạn nên đăng bài mới, đúng chủ đề, rõ nội dung câu hỏi, và ... kèm file chứ không phải kèm hình ảnh.

1convit789 · 16/10/19

Ba Tê đã viết:
Đầu câu nhớ viết Hoa.
Chú ý chính tả "lổi", "hổ trợ".

Bài đã được tự động gộp: 16/10/19

@1convit789
1/ Bạn đang chen ngang vào topic của người khác mà nội dung không như chủ đề topic.
2/ Bạn nên đăng bài mới, đúng chủ đề, rõ nội dung câu hỏi, và ... kèm file chứ không phải kèm hình ảnh.

là sao bạn mình thấy thao tác bằng pivot nhanh hơn mà đỡ đau đầu thì mình gắn kèm hình ảnh tùy chỉnh cái pivot nó đúng với @
HTN033 cần thôi chứ có gì đâu mà Report"Bạn đang chen ngang vào topic của người khác mà nội dung không như chủ đề topic."

Ba Tê · 16/10/19

1convit789 đã viết:
là sao bạn mình thấy thao tác bằng pivot nhanh hơn mà đỡ đau đầu thì mình gắn kèm hình ảnh tùy chỉnh cái pivot nó đúng với @
HTN033 cần thôi chứ có gì đâu mà Report"Bạn đang chen ngang vào topic của người khác mà nội dung không như chủ đề topic."

Tôi xin lỗi vì không hiểu ý bạn.

Sum of total	Column Labels
Row Labels	14-Oct	15-Oct	16-Oct	17-Oct	18-Oct	19-Oct	Grand Total
ASV		24.95	2.38				27.33
BJV	12.21	61.41					73.62
CCV	2.95	11.82	3.22	0.52			18.51
CVT		98.92	12.48		19.04		130.44
DDV		18.22	33.69		0.1		52.01
DGV	4.47	7.51	1.66				13.64
EA4	1.23	25.61	9.74	36.49	13.53		86.6
EAV		3.82	2.64		18.99		25.45
EDV	1.97		0.49		100.14		102.6
EEO		101.41	93.76			29.6	224.77
EGN		0.12	70.89				71.01
EOL	7.87	138.39	12.3			45.45	204.01
ESV		18.11	10.92				29.03
EVT	4.5	55.39	13.67	0.42	3.8		77.78
FVN		379.11	101.61				480.72
HSV		1.97					1.97
HTV		3.91	3.78				7.69
NIV		433.79	88.24	37.43	70.74		630.2
NVC		22.42	63.68	86.53	88.01		260.64
NYV		3.51					3.51
PRE		65.95	3.7				69.65
QVE	2.53	113.46	0.03				116.02
SIV	33.74	542.26	156.38	0.25		23.39	756.02
SVV		5.451					5.451
TMV	30.16	59.32	24.62			0.48	114.58
USV	0.02	17.67	2.25				19.94
V2	105.71	202.76	252.33	171.74	134.86	40.7	908.1
VE	205.38	51.15	88.75	217.92	1274.01		1837.21
VF			22.82	246.25	157.72	878.49	1305.28
VG		81		118.78	36.57		236.35
VH	84.19	154.74	189.85	151.82	175.35	438.53	1194.48
VJ	192.18	91.16	278.14	360.24	926.11	284.34	2132.17
VL	172.46	95.74	148.1	99.87	78.83	112.18	707.18
VM	244.72	2.65	20.08			657.99	925.44
VO	142.69	118.04	30.2	5.52	183.82	525.9	1006.17
VP	102.27	144.5	344.35	85.77	286.74	65.95	1029.58
VT	860.44	1347.79	218.74	77.58	219.76	958.98	3683.29
VW	126.03	105.12	334.72	77.15	252.88	512.36	1408.26
VX	58.08	2.83	2.09		70.64	396.32	529.96
VY	110.05	14.71	178	239.85	471.63	193.34	1207.58
XV						37.75	37.75
Grand Total	2505.85	4626.691	2820.3	2014.13	4583.27	5201.75	21751.991

Trích Lọc dữ liệu với Macro

Thành viên mới

File đính kèm

Thành viên mới

Cạo Rồi Khỏi Gội

File đính kèm

Thành viên mới

Thành viên gạo cội

File đính kèm

Thành viên thường trực

Thành viên mới

File đính kèm

Thành viên mới

File đính kèm

GPE - My love

Cạo Rồi Khỏi Gội

Thành viên thường trực

GPE - My love

Thành viên mới

Thành viên thường trực

File đính kèm

Thành viên chính thức

File đính kèm

Cạo Rồi Khỏi Gội

File đính kèm

Thành viên chính thức

Cạo Rồi Khỏi Gội

Facebook

Group