Hướng dẫn lọc tất cả ngày có dữ liệu trùng nhau (1 người xem)

[saobekhonglac]

Chào Anh, Chị.

Nhờ Anh, Chị hướng dẫn giúp công thức hoặc VBA lọc tất cả ngày có dữ liệu giống nhau như file đính kèm.
Sheet "Du lieu" cột A có từ ngày 1/1/2020 đến 31/12/2020. Dòng 2 là giờ và phút trong 1 ngày. Bên dưới sẽ có các giá trị tương ứng -1,0,-1
Sheet "Loc" Gõ giờ và phút từ B1 tới F1. B2 đến F2 mình gõ giá trị bất kỳ -1,0,1
Từ A2 nhờ Anh, Chị dùng công thức hoặc VBA để lọc ra hết những ngày có giá trị trùng với những giá trị từ B2 đến F2 tương ứng với giờ, phút tại B1 đến F1.
Như ví dụ những giờ, phút và giá trị mình chọn thì có 2 ngày là 18/07/2021 và 14/08/2020.

Cám ơn.

 

[HUONGHCKT]

Chào Anh, Chị.

Nhờ Anh, Chị hướng dẫn giúp công thức hoặc VBA lọc tất cả ngày có dữ liệu giống nhau như file đính kèm.
Sheet "Du lieu" cột A có từ ngày 1/1/2020 đến 31/12/2020. Dòng 2 là giờ và phút trong 1 ngày. Bên dưới sẽ có các giá trị tương ứng -1,0,-1
Sheet "Loc" Gõ giờ và phút từ B1 tới F1. B2 đến F2 mình gõ giá trị bất kỳ -1,0,1
Từ A2 nhờ Anh, Chị dùng công thức hoặc VBA để lọc ra hết những ngày có giá trị trùng với những giá trị từ B2 đến F2 tương ứng với giờ, phút tại B1 đến F1.
Như ví dụ những giờ, phút và giá trị mình chọn thì có 2 ngày là 18/07/2021 và 14/08/2020.

Cám ơn.

Trong khi chờ các anh chị em khác cung cấp cách giải , thử dùng đoạn code củ chuối này xem sao.

Sub LOC()
Dim Arr(), KQ()
Dim i&, j&, k&, Lr&
With Sheets("Dulieu")
Lr = .Cells(Rows.Count, 1).End(3).Row
Arr = .Range("A3:F" & Lr).Value
End With
With Sheets("Loc")
ReDim KQ(1 To UBound(Arr), 1 To 6)
For i = 1 To UBound(Arr)
DK = Arr(i, 2) & Arr(i, 3) & Arr(i, 4) & Arr(i, 5) & Arr(i, 6)
DL = .[B2] & .[C2] & .[D2] & .[E2] & .[F2]
If DK = DL Then
t = t + 1
For j = 1 To 6
KQ(t, j) = Arr(i, j)
Next j
End If
Next i
End With
If t Then Sheets("Loc").[A3].Resize(t, 6) = KQ
End Sub

 

[saobekhonglac]

Trong khi chờ các anh chị em khác cung cấp cách giải , thử dùng đoạn code củ chuối này xem sao.

Sub LOC()
Dim Arr(), KQ()
Dim i&, j&, k&, Lr&
With Sheets("Dulieu")
Lr = .Cells(Rows.Count, 1).End(3).Row
Arr = .Range("A3:F" & Lr).Value
End With
With Sheets("Loc")
ReDim KQ(1 To UBound(Arr), 1 To 6)
For i = 1 To UBound(Arr)
DK = Arr(i, 2) & Arr(i, 3) & Arr(i, 4) & Arr(i, 5) & Arr(i, 6)
DL = .[B2] & .[C2] & .[D2] & .[E2] & .[F2]
If DK = DL Then
t = t + 1
For j = 1 To 6
KQ(t, j) = Arr(i, j)
Next j
End If
Next i
End With
If t Then Sheets("Loc").[A3].Resize(t, 6) = KQ
End Sub

Cái này thay đổi giờ, phút từ B1 tới F1 thì dữ liệu vẫn lấy từ cột B đến F bên Sheet "Du lieu"

 

[BuiQuangThuan]

Trong khi chờ các anh chị em khác cung cấp cách giải , thử dùng đoạn code củ chuối này xem sao.

Gop thêm 1 cách khác theo anh nếu thớt muốn như kết quả của anh

Sub ABC()
    Dim Arr(), Res(), i&, Dic As Object, ikey$, DK$, iR
    Set Dic = CreateObject("scripting.dictionary")
    With Sheet1
        Arr = .Range("A3:F" & .Range("A" & Rows.Count).End(3).Row)
    End With
    iR1 = UBound(Arr, 1)
    ReDim Res(1 To UBound(Arr, 1), 1 To 6)
    With Sheet2
        DK = "#" & .[B2] & "#" & .[C2] & "#" & .[D2] & "#" & .[E2] & "#" & .[F2] & "#"
    End With
    For i = 1 To UBound(Arr, 1)
        ikey = "#" & Arr(i, 2) & "#" & Arr(i, 3) & "#" & Arr(i, 4) & "#" & Arr(i, 5) & "#" & Arr(i, 6) & "#"
        Dic.Item(Arr(i, 1)) = i
        If ikey <> DK Then Dic.Remove (Arr(i, 1))
    Next
    For Each iR In Dic.items
        k = k + 1
        For j = 1 To UBound(Arr, 2)
            Res(k, j) = Arr(iR, j)
        Next j
    Next iR
    Sheet2.Range("K3").Resize(k, 6).Value = Res
End Sub

 

[saobekhonglac]

Gop thêm 1 cách khác theo anh nếu thớt muốn như kết quả của anh

Sub ABC()
    Dim Arr(), Res(), i&, Dic As Object, ikey$, DK$, iR
    Set Dic = CreateObject("scripting.dictionary")
    With Sheet1
        Arr = .Range("A3:F" & .Range("A" & Rows.Count).End(3).Row)
    End With
    iR1 = UBound(Arr, 1)
    ReDim Res(1 To UBound(Arr, 1), 1 To 6)
    With Sheet2
        DK = "#" & .[B2] & "#" & .[C2] & "#" & .[D2] & "#" & .[E2] & "#" & .[F2] & "#"
    End With
    For i = 1 To UBound(Arr, 1)
        ikey = "#" & Arr(i, 2) & "#" & Arr(i, 3) & "#" & Arr(i, 4) & "#" & Arr(i, 5) & "#" & Arr(i, 6) & "#"
        Dic.Item(Arr(i, 1)) = i
        If ikey <> DK Then Dic.Remove (Arr(i, 1))
    Next
    For Each iR In Dic.items
        k = k + 1
        For j = 1 To UBound(Arr, 2)
            Res(k, j) = Arr(iR, j)
        Next j
    Next iR
    Sheet2.Range("K3").Resize(k, 6).Value = Res
End Sub

Cũng không đúng ý mình, nếu thay đổi giờ và phút ở B1 đến F1 thì vẫn ra kết quả của cột B tới F bên Sheet "Du lieu"

 

[concogia]

Chào Anh, Chị.

Nhờ Anh, Chị hướng dẫn giúp công thức hoặc VBA lọc tất cả ngày có dữ liệu giống nhau như file đính kèm.
Sheet "Du lieu" cột A có từ ngày 1/1/2020 đến 31/12/2020. Dòng 2 là giờ và phút trong 1 ngày. Bên dưới sẽ có các giá trị tương ứng -1,0,-1
Sheet "Loc" Gõ giờ và phút từ B1 tới F1. B2 đến F2 mình gõ giá trị bất kỳ -1,0,1
Từ A2 nhờ Anh, Chị dùng công thức hoặc VBA để lọc ra hết những ngày có giá trị trùng với những giá trị từ B2 đến F2 tương ứng với giờ, phút tại B1 đến F1.
Như ví dụ những giờ, phút và giá trị mình chọn thì có 2 ngày là 18/07/2021 và 14/08/2020.

Cám ơn.

Thử em này coi sao, dữ liệu như đám rừng không thử được, chóng mặt lắm
Nếu số cột điều kiện thay đổi phải khai báo lại, làm theo đề bài thôi
Thân

 

[SA_DQ]

Thêm 1 cách nữa nè: Hàng phụ (chuyển DL thời gian tương ứng thành chỉ số cột của mảng)