返回列表 上一主題 發帖

[發問] 請問要如何指定刪除資料

cclo0728

帖子
53 
主題
8 
精華
0 
積分
90 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
20 
註冊時間
2019-4-30 
最後登錄
2023-4-25 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2021-12-27 16:08 | 只看該作者

[發問] 請問要如何指定刪除資料

各位學長好:
我在網路上收尋到一段程式，雖然很好用
但每日資料庫有上萬筆資料，造成每一項檢查+刪除花了很久時間
有辦法在簡化檢查的時間嗎?預計開工日已有依照時間排序

    Set sh1 = Sheets(1) '刪除開工日超過今天
    f = sh1.Columns("A:L").Find("*", LookIn:=xlValues, SearchDirection:=xlPrevious).Row
    On Error Resume Next
    dn = Date + 1
    For i = f To 2 Step -1
    If IsError(sh1.Cells(i, "L")) = False Or sh1.Cells(i, "L") <> "" Then
    dv2 = sh1.Cells(i, "K")
    y2 = Format(Left(dv2, 4), "0000")
    m2 = Format(Mid(dv2, 5, 2), "00")
    d2 = Format(Mid(dv2, 7, 2), "00")
    dv2 = DateValue(Format(y2 & "/" & m2 & "/" & d2, "yyyy/mm/dd"))
    If dv2 > dn Then
    sh1.Rows(i).Delete Shift:=xlUp
    End If
    End If
    Next

活頁簿2.rar (14.21 KB)

收藏 分享

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2024-10-30 
2#
發表於 2021-12-27 16:48 | 只看該作者
本帖最後由 samwang 於 2021-12-27 16:53 編輯
各位學長好:
我在網路上收尋到一段程式，雖然很好用
但每日資料庫有上萬筆資料，造成每一項檢查+刪除花了 ...
cclo0728 發表於 2021-12-27 16:08


您的需求是刪除大於今日預計開工(母)嗎? 請確認，謝謝

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2024-10-30 
3#
發表於 2021-12-28 07:48 | 只看該作者
回復 1# cclo0728
請測試看看，謝謝
Sub test()
Dim Arr, SD As Date, y2, m2, d2, i&, j%, n%
Application.ScreenUpdating = False
Tm = Timer
With Range("a1").CurrentRegion
    Arr = .Value
    For i = 2 To UBound(Arr)
        y2 = Format(Left(Arr(i, 11), 4), "0000")
        m2 = Format(Mid(Arr(i, 11), 5, 2), "00")
        d2 = Format(Mid(Arr(i, 11), 7, 2), "00")
        SD = DateSerial(y2, m2, d2)
        If SD < Date Then
            n = n + 1
            For j = 1 To UBound(Arr, 2): Arr(n, j) = Arr(i, j): Next
        End If
    Next
    If n > 0 Then
        .Range("a1").CurrentRegion.Offset(1) = ""
        .Range("a2").Resize(n, UBound(Arr, 2)) = Arr
    End If
End With
Application.ScreenUpdating = True
MsgBox Timer - Tm
End Sub

TOP

cclo0728

帖子
53 
主題
8 
精華
0 
積分
90 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
20 
註冊時間
2019-4-30 
最後登錄
2023-4-25 
4#
發表於 2021-12-28 08:24 | 只看該作者
您的需求是刪除大於今日預計開工(母)嗎? 請確認，謝謝
samwang 發表於 2021-12-27 16:48

是的，但要多加一天，因為發料要提早一步，所以今天是28號的話，日期都要+1

TOP

cclo0728

帖子
53 
主題
8 
精華
0 
積分
90 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
20 
註冊時間
2019-4-30 
最後登錄
2023-4-25 
5#
發表於 2021-12-28 08:24 | 只看該作者
回復  cclo0728
請測試看看，謝謝
Sub test()
Dim Arr, SD As Date, y2, m2, d2, i&, j%, n%
Applicat ...
samwang 發表於 2021-12-28 07:48


感謝回覆，我等等測試看看，謝謝

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2024-10-30 
6#
發表於 2021-12-28 08:29 | 只看該作者
是的，但要多加一天，因為發料要提早一步，所以今天是28號的話，日期都要+1
cclo0728 發表於 2021-12-28 08:24


是的，但要多加一天，因為發料要提早一步，所以今天是28號的話，日期都要+1
>> If SD <= Date Then
修改如紅字，謝謝

TOP

cclo0728

帖子
53 
主題
8 
精華
0 
積分
90 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
20 
註冊時間
2019-4-30 
最後登錄
2023-4-25 
7#
發表於 2021-12-28 10:33 | 只看該作者
是的，但要多加一天，因為發料要提早一步，所以今天是28號的話，日期都要+1
>> If SD
samwang 發表於 2021-12-28 08:29


感謝~非常感謝你的幫忙，測試使用沒問題
而且速度很快，我來研究一下
謝謝

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-27 
8#
發表於 2021-12-28 13:53 | 只看該作者
SD = Format(Arr(i, 11), "0-00-00")

或先將當天轉成8位數字
TD& = Format(Date, "YYYYMMDD")
If Val(Arr(i, 11)) <= TD Then

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2024-10-30 
9#
發表於 2021-12-28 15:03 | 只看該作者
SD = Format(Arr(i, 11), "0-00-00")

或先將當天轉成8位數字
TD& = Format(Date, "YYYYMMDD")
If Val( ...
准提部林 發表於 2021-12-28 13:53


感謝准大提醒，學習了，謝謝

TOP

        靜思自在 : 做好事不能少我一人，做壞事不能多我一人。
返回列表 上一主題