Xin góp ý về code xóa dữ liệu theo đúng ngày chỉ định

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài

Doanh94

Thành viên mới
Tham gia
27/6/23
Bài viết
2
Được thích
0
Xin chào các bác mình có viết được 1 code để xóa dữ liệu theo đúng ngày chỉ định nhưng mình chỉ muốn code này nó xóa 1 lần duy nhất và tự động lưu file đó sau khi xóa hết dữ liệu. Rất mong nhận được sự trợ giúp của mọi người
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim currentDate As Date
Dim targetRange As Range
Dim i As Integer
Set ws = ThisWorkbook.Sheets("Sheet1")
Set targetRange = ws.Range("A1:E25")
currentDate = Date
For i = 1 To 1
If currentDate > DateSerial(2024, 7, 13) Then
targetRange.ClearContents
End If
Next i
ThisWorkbook.Save
End Sub
 

File đính kèm

  • bbbb.xlsm
    14.5 KB · Đọc: 7
Tôi nghĩ bài này chắc phải dùng Name để lưu thông tin đã xóa dữ liệu (vd: daXoa=True để code kiểm tra mỗi khi mở file. Chưa làm thử :).
 
Xin chào các bác mình có viết được 1 code để xóa dữ liệu theo đúng ngày chỉ định nhưng mình chỉ muốn code này nó xóa 1 lần duy nhất và tự động lưu file đó sau khi xóa hết dữ liệu. Rất mong nhận được sự trợ giúp của mọi người
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim currentDate As Date
Dim targetRange As Range
Dim i As Integer
Set ws = ThisWorkbook.Sheets("Sheet1")
Set targetRange = ws.Range("A1:E25")
currentDate = Date
For i = 1 To 1
If currentDate > DateSerial(2024, 7, 13) Then
targetRange.ClearContents
End If
Next i
ThisWorkbook.Save
End Sub
Code của bạn xóa 1 lần là xong rồi.Xóa xong cho nó thoát vòng lặp đi. exit for.Mà sao for i=1 to 1 để trong vòng lặp làm gì vậy.
 
Private Sub Worksheet_Change(ByVal Target As Range)
End Sub
Nên dùng bắt sự kiện trước / sau khi mở file hoặc lưu file, chứ xóa thì có 1 lần, mà cứ khi file có thay đổi lại chạy xóa dữ liệu và không cần thiết.
Mặt khác nên bẫy hoặc ghi chú là đã xóa, ví dụ đã xóa vào ngày 15.7 1 lần thì không xóa nữa chẳng hạn.
Mà kiểu làm này khá nguy hiểm, sai cái là ăn hành vì mất dữ liệu.
 
Nên dùng bắt sự kiện trước / sau khi mở file hoặc lưu file, chứ xóa thì có 1 lần, mà cứ khi file có thay đổi lại chạy xóa dữ liệu và không cần thiết.
Mặt khác nên bẫy hoặc ghi chú là đã xóa, ví dụ đã xóa vào ngày 15.7 1 lần thì không xóa nữa chẳng hạn.
Mà kiểu làm này khá nguy hiểm, sai cái là ăn hành vì mất dữ liệu.
Vấn đề chính là bảng tính sẽ được đọc như thế nào?
Người dùng có biết rằng sau ngày …. mớ dữ liệu trong range … sẽ bị xoá không?
Âm thầm lặng lẽ xoá dữ liệu đã gởi cho khách hàng là khá tàn ác.
“Dạ thưa sếp. từ file dữ liệu bên cung cấp, em phân tích được như vầy…”
“Tôi có thấy bên cung cấp nó đưa ra cái gì liên quan đến chỗ phân tích của chú đâu?”
 
Tôi làm thử theo cách lưu thông tin cờ hiệu [đã xóa] xuống một sheet ẩn (xlSheetVeryHidden) chứ không lưu vào Name range vì sợ người dùng dọn rác mấy cái Name thì báo lỗi ngay.
- Điều kiện chạy code cơ bản là trên máy tính nào sử dụng phải Enable macro, nếu không thì cũng chẳng có tác dụng gì.
- Đổi tham số [DaXoa] = False để kiểm tra code xóa tự động.
- File backup lưu ở thư mục Documents.

Screen Shot 2024-07-16 at 07.58.47.png

JavaScript:
Option Explicit

Private Sub Workbook_Open()
    deleteContent
End Sub

Sub deleteContent()
    Dim ws As Worksheet, targetRange As Range
    Dim deleteDate As Date

    Application.EnableEvents = True

    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set targetRange = ws.Range("A1:E25")
    deleteDate = CDate(ThisWorkbook.Worksheets("setting").Range("B1").Value)
  
    If deleteStatus(deleteDate) Then Exit Sub

    If Date > deleteDate Then
        setDeleteFlag True      'Phai set truoc cho file bkup de khoi chay macro
        bkupWorkbook
        targetRange.ClearContents
    End If

    'Save file
    ThisWorkbook.Save
  
End Sub

Sub bkupWorkbook()
    Dim fileFolder As String, fileBkupName As String
  
    fileBkupName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) & "_bkup_" & Format(Date, "yyyymmdd") & ".xlsm"
    fileFolder = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\"
    ActiveWorkbook.SaveCopyAs fileFolder & fileBkupName
End Sub

Sub setDeleteFlag(blnDaXoa As Boolean)
    ThisWorkbook.Worksheets("setting").Range("B2").Value = blnDaXoa
End Sub

'/Kiem tra tham so [DaXoa] truoc khi chay macro xoa
Function deleteStatus(deleteDate As Date) As Boolean
    If Date <= deleteDate Then
        deleteStatus = True         'gán da Xóa = True de khoi chay code xóa
    Else
        deleteStatus = ThisWorkbook.Worksheets("setting").Range("B2").Value
    End If
End Function
 

File đính kèm

  • XoaTheoNgay.xlsm
    18.2 KB · Đọc: 11
Cảm ơn các bác em đã làm được rồi.
 
Web KT
Back
Top Bottom