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

Liên hệ QC

dunglehoang98

Thành viên mới
Tham gia
30/1/20
Bài viết
6
Được thích
0
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

  • Mydata.xlsx
    4.8 MB · Đọc: 12
Lần chỉnh sửa cuối:
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é.
 
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é.
 
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

  • Mydata.xlsm
    4.8 MB · Đọc: 9
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
 
Web KT
Back
Top Bottom