Lọc dữ liệu trùng lặp theo tháng (2 người xem)

[dunglehoang98]

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

 

[snow25]

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]

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]

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é.

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

 

[dunglehoang98]

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é.

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 @@

 

[snow25]

Hic mình chạy nó ra như cái này @@
View attachment 231455

Bạn tạo thêm 1 sheets ketqua nữa xem nào.

 

[dunglehoang98]

Bạn tạo thêm 1 sheets ketqua nữa xem nào.

Nó vẫn báo lỗi vậy bạn ơi (

 

[snow25]

Nó vẫn báo lỗi vậy bạn ơi (

Bạn gửi file chạy lỗi lên nhé.Và xem nó bị lỗi gì bấm vào Debug nhé.

 

[dunglehoang98]

Bạn gửi file chạy lỗi lên nhé.Và xem nó bị lỗi gì bấm vào Debug nhé.

Mình chạy trên file giả lập, nhưng vẫn không ra kết quả

 

[snow25]

Mình chạy trên file giả lập, nhưng vẫn không ra kết quả

Thì bạn có thấy dữ liệu nào thỏa mãn điều kiện không.

 

[dunglehoang98]

Thì bạn có thấy dữ liệu nào thỏa mãn điều kiện không.

Có bạn ơi nhưng chạy VBA lại không ra được kết quả @@

 

[snow25]

Có bạn ơi nhưng chạy VBA lại không ra được kết quả @@

Bạn đưa cái kết quả bạn nói là có xem nào.

 

[VetMini]

Hi mọi người,
...

Sửa lại thành tiếng Việt rồi tôi mách cho cách giải.