Lọc dữ liệu trùng lặp theo tháng

dunglehoang98

Thành viên mới
Tham gia ngày
30 Tháng một 2020
Bài viết
6
Được thích
0
Điểm
13
Tuổi
22
Hi mọi người,

Em có file danh sách các item được mua theo tháng trong suốt 2 năm 2018-2019, và em đang muốn lọc ra dữ liệu nào có tần suất xuất hiện theo tháng, tức là 12 tháng tháng nào cũng xuất hiện thường xuyên.

Đại loại là em cần tìm item nào tháng nào cũng được mua. File đính kèm ạ

Mọi người chỉ giúp em với ạ.

Cảm ơn mọi người nhiều
 

File đính kèm

Lần chỉnh sửa cuối:

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
2,462
Được thích
2,321
Điểm
360
Hi mọi người,

Em có file danh sách các item được mua theo tháng trong suốt 2 năm 2018-2019, và em đang muốn lọc ra dữ liệu nào có tần suất xuất hiện theo tháng, tức là 12 tháng tháng nào cũng xuất hiện thường xuyên.

Em có file nhưng dữ liệu rất lớn và bảo mật nên không tải lên được. Đại loại là em cần tìm item nào tháng nào cũng được mua.

Mọi người chỉ giúp em với ạ.

Cảm ơn mọi người nhiều
Chương trình thầy bói xem voi bắt đầu.
Nếu không đưa được dữ liệu lên thì ít nhất bạn cũng phải có dữ liệu giả lập như thế nào chứ.Ai biết cái file của bạn bố trí như thế nào mà giúp.Mà file 2 năm chắc dữ liệu lớn bạn nên tìm hiểu VBA nhé.
 

dunglehoang98

Thành viên mới
Tham gia ngày
30 Tháng một 2020
Bài viết
6
Được thích
0
Điểm
13
Tuổi
22
Chương trình thầy bói xem voi bắt đầu.
Nếu không đưa được dữ liệu lên thì ít nhất bạn cũng phải có dữ liệu giả lập như thế nào chứ.Ai biết cái file của bạn bố trí như thế nào mà giúp.Mà file 2 năm chắc dữ liệu lớn bạn nên tìm hiểu VBA nhé.
Hi bạn, mình đã bỏ file đính kèm rồi. Bạn xem thử rồi giúp mình xem được không nhé.
 

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
2,462
Được thích
2,321
Điểm
360
Hi bạn, mình đã bỏ file đính kèm rồi. Bạn xem thử rồi giúp mình xem được không nhé.
Bạn thử chạy cái Sub này nhé.Dùng VBA.Bạn cho dữ liệu đầy đủ vào xem nó có ra kết quả đúng không nhé.
Mã:
Sub linhtinh()
    Dim arr, i As Long, j As Long, lr As Long, kq, dic As Object, dk As String, a As Long, b As Long, ketqua, c As Integer
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("Master file ")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         arr = .Range("A2:B" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To 1)
    End With
        For i = 1 To UBound(arr)
          If Len(arr(i, 2)) And IsDate(arr(i, 1)) Then
            dk = arr(i, 2) & "#" & Month(arr(i, 1))
            If Not dic.exists(dk) Then
               dic.Add dk, ""
               dk = arr(i, 2)
               If Not dic.exists(dk) Then
                  a = a + 1
                  kq(a, 1) = dk
                  dic.Add dk, 1
               Else
                  c = dic.Item(dk) + 1
                  dic.Item(dk) = dic.Item(dk) + 1
               End If
            End If
         End If
        Next i
        ReDim ketqua(1 To a, 1 To 1)
        For i = 1 To a
            dk = kq(i, 1)
            c = dic.Item(dk)
            If c = 12 Then
               b = b + 1
               ketqua(b, 1) = dk
            End If
        Next i
   With Sheets("ketqua")
        .Range("A2:A10000").ClearContents
        If b Then .Range("a2").Resize(b).Value = ketqua
   End With
End Sub
 

File đính kèm

dunglehoang98

Thành viên mới
Tham gia ngày
30 Tháng một 2020
Bài viết
6
Được thích
0
Điểm
13
Tuổi
22
Bạn thử chạy cái Sub này nhé.Dùng VBA.Bạn cho dữ liệu đầy đủ vào xem nó có ra kết quả đúng không nhé.
Mã:
Sub linhtinh()
    Dim arr, i As Long, j As Long, lr As Long, kq, dic As Object, dk As String, a As Long, b As Long, ketqua, c As Integer
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("Master file ")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         arr = .Range("A2:B" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To 1)
    End With
        For i = 1 To UBound(arr)
          If Len(arr(i, 2)) And IsDate(arr(i, 1)) Then
            dk = arr(i, 2) & "#" & Month(arr(i, 1))
            If Not dic.exists(dk) Then
               dic.Add dk, ""
               dk = arr(i, 2)
               If Not dic.exists(dk) Then
                  a = a + 1
                  kq(a, 1) = dk
                  dic.Add dk, 1
               Else
                  c = dic.Item(dk) + 1
                  dic.Item(dk) = dic.Item(dk) + 1
               End If
            End If
         End If
        Next i
        ReDim ketqua(1 To a, 1 To 1)
        For i = 1 To a
            dk = kq(i, 1)
            c = dic.Item(dk)
            If c = 12 Then
               b = b + 1
               ketqua(b, 1) = dk
            End If
        Next i
   With Sheets("ketqua")
        .Range("A2:A10000").ClearContents
        If b Then .Range("a2").Resize(b).Value = ketqua
   End With
End Sub
Hic mình chạy nó ra như cái này @@
1580375377462.png
 
Top Bottom