請問該怎麼寫-VBA-相同類的資料，依條件再去除

vba excel excel vba

what0208 2022-05-19 16:03:45 ‧ 932 瀏覽

分享至

如下圖
我想把紅色的資料依條件做刪除，整理完後會變成黃色的資料那樣。
條件是，只要針對類別1來做處理，相同姓名的如果結束時間不超過08:03後的筆數(包含08:03)。就要刪除前二筆資料。第3筆後都要保留。如果是過08:03的，全數保留。
想用vba來完成，請問該怎麼實現呢?

blanksoul12 iT邦研究生 5 級 ‧ 2022-05-19 16:52:46 檢舉

BBB 的18及19號的也留? 因為超過三筆?

blanksoul12 iT邦研究生 5 級 ‧ 2022-05-19 17:21:17 檢舉

7號的 EEE 算是第三筆還是第二筆?
BBB 的類別2算是第幾筆?

what0208 iT邦新手 5 級 ‧ 2022-05-19 17:42:34 檢舉

BBB 的18及19號的也留? 因為超過三筆?--->因為已經刪除5及6號的，一個人最多二次遲到的優惠。
7號的 EEE 算是第三筆還是第二筆?--->我用錯了，EEE應該是保留7號的資料才對，不是4號。
BBB 的類別2算是第幾筆?--->類別2的完全不用考慮絛件，但要保留資料。

登入發表討論

直播研討會

{{ item.channelVendor }} {{ item.webinarstarted }} |

直播中

2 個回答

blanksoul12

iT邦研究生 5 級 ‧ 2022-05-19 17:47:54

最佳解答

自己改改

Sub cfz()

Set d = CreateObject("Scripting.Dictionary")

Arr = Range("a2:c" & [a1048576].End(xlUp).Row)
For i = 1 To UBound(Arr)
    d(Arr(i, 1)) = d(Arr(i, 1)) + 1
Next
k = d.keys
t = d.items

For Each info In k
    x = 1
    For i = 2 To [a1048576].End(xlUp).Row
        If Cells(i, "a") = info And Cells(i, "b") = 1 Then
            If x < 3 And TimeValue(Cells(i, "c")) > "8:03:00" Then
                [e1048576].End(xlUp).Offset(1, 0).Resize(1, 3) = Application.Index(Arr, i - 1)
            ElseIf TimeValue(Cells(i, "c")) > "8:03:00" Then
                [e1048576].End(xlUp).Offset(1, 0).Resize(1, 3) = Application.Index(Arr, i - 1)
            ElseIf x > 2 Then
                [e1048576].End(xlUp).Offset(1, 0).Resize(1, 3) = Application.Index(Arr, i - 1)
            Else
                x = x + 1
            End If
        ElseIf Cells(i, "a") = info And Cells(i, "b") = 2 Then
            [e1048576].End(xlUp).Offset(1, 0).Resize(1, 3) = Application.Index(Arr, i - 1)
        End If
        DoEvents
    Next
Next

End Sub