Xóa tháng trong tất cả các Sheet trong excel (1 người xem)

[anhhuyconan]

Chào các bạn tình hình là mình định xóa tất cả các hết các tháng chỉ để lại một tháng thôi vì nếu xóa từng sheet thì nhiều quá. Ví dụ như mình sẽ xóa hết các dòng từ ngày 30/4 trở về trước, chỉ để lại từ ngày 30/4 - >1/5, mong các bạn giúp đỡ, xin cảm ơn rất nhiều, mình có để hình bên dưới và file

 

[Phuocam]

Thử code này, hên xui:

Public Sub XoaDuLieu()
Dim ws As Worksheet
Dim i As Long
Dim lastRow As Long
Application.DisplayAlerts = False
For Each ws In Worksheets
With ws
    lastRow = .Range("A" & Rows.Count).End(xlUp).Row
    If lastRow >= 10 Then
        For i = lastRow To 10 Step -1
            If .Cells(i, "A").Value < DateSerial(2018, 4, 30) Then
            .Rows(i).Delete
            End If
        Next
    End If
End With
Next ws
Application.DisplayAlerts = True
End Sub

 

[phulien1902]

Code này dường như vẫn chưa đáp ứng yêu cầu chủ Topic, hơn nữa chủ Topic chỉ nói < 30/4, chứ có nói gì đến năm nào đâu nhỉ?

 

[nguyenthuy13388]

Chào các bạn tình hình là mình định xóa tất cả các hết các tháng chỉ để lại một tháng thôi vì nếu xóa từng sheet thì nhiều quá. Ví dụ như mình sẽ xóa hết các dòng từ ngày 30/4 trở về trước, chỉ để lại từ ngày 30/4 - >1/5, mong các bạn giúp đỡ, xin cảm ơn rất nhiều, mình có để hình bên dưới và file

thử code này xem bạn:

Sub xoa_dong()

Dim i As Long
Dim j As Long
Dim a As Date
For j = 1 To 100
Worksheets(j).Activate
For i = 9 To 100
a = Cells(i, 1)

    If a <= "30/04/2018" Then
    Rows(i).Delete
    End If

Next i
Next j

End Sub

 

[Phuocam]

Code này dường như vẫn chưa đáp ứng yêu cầu chủ Topic, hơn nữa chủ Topic chỉ nói < 30/4, chứ có nói gì đến năm nào đâu nhỉ?

Dữ liệu trong file, chỗ ngày tháng ,chỗ text nên mới có "hên xui"

 

[nguyenthuy13388]

Thử code này, hên xui:

Public Sub XoaDuLieu()
Dim ws As Worksheet
Dim i As Long
Dim lastRow As Long
Application.DisplayAlerts = False
For Each ws In Worksheets
With ws
    lastRow = .Range("A" & Rows.Count).End(xlUp).Row
    If lastRow >= 10 Then
        For i = lastRow To 10 Step -1
            If .Cells(i, "A").Value < DateSerial(2018, 4, 30) Then
            .Rows(i).Delete
            End If
        Next
    End If
End With
Next ws
Application.DisplayAlerts = True
End Sub

tại sao chạy code của Bác lại nhanh thế nhỉ

 

[anhhuyconan]

cảm ơn Phuocam, mình sẽ thử

 

[♫ђöล♥ßล†♥†µ♫]

Dữ liệu trong file, chỗ ngày tháng ,chỗ text nên mới có "hên xui"

Em thử chém cái ngày tháng ra thành 3 mảng như thế này Anh ạ

Option Explicit
Public Const Days As Date = #4/30/2018#
Public Sub XoaDuLieu()
    Dim ws As Worksheet, aTmp, fDate As Date
    Dim Rng As Range, i As Long, lastRow As Long
Application.DisplayAlerts = False
For Each ws In Worksheets
    With ws
        lastRow = .Range("A" & Rows.Count).End(xlUp).Row
        If lastRow >= 10 Then
            For i = lastRow To 10 Step -1
                fDate = Format(.Range("A" & i), "dd/mm/yy")
                aTmp = Split(fDate, "/")
                fDate = DateSerial(aTmp(2), aTmp(1), aTmp(0))
                If fDate < Days Then
                    If Rng Is Nothing Then
                        Set Rng = .Range("A" & i).EntireRow
                    Else
                        Set Rng = Union(Rng, .Range("A" & i).EntireRow)
                    End If
                End If
            Next
        End If
        If Not Rng Is Nothing Then
            'Rng.Delete
            Rng.Interior.Color = 65535
        End If
    End With
    Set Rng = Nothing
Next ws
Application.DisplayAlerts = True
End Sub