• Najnowsze pytania
  • Bez odpowiedzi
  • Zadaj pytanie
  • Kategorie
  • Tagi
  • Zdobyte punkty
  • Ekipa ninja
  • IRC
  • FAQ
  • Regulamin
  • Książki warte uwagi

VBA excel makro - usuwanie wierszy, gdy data starsza niż podana

VPS Starter Arubacloud
0 głosów
930 wizyt
pytanie zadane 8 maja 2017 w Visual Basic przez karolina.n28 Nowicjusz (240 p.)

Dzień dobry,

Proszę o pomoc w poprawieniu kodu tak, żeby po uruchomieniu usunął wiersze, w których występuje data wcześniejsza niż 2016-05-02 we wszystkich arkuszach (a nie tylko w arkuszu Sheet1 jak jest poniżej). W kolumnie A są daty. 

Poniższy kod znalazłam w sieci, sama niestety póki co jestem zupełnym laikiem.

Sub DeleteDateWithAutoFilter()

Dim MySheet As Worksheet, MyRange As Range
Dim LastRow As Long, LastCol As Long

'turn off alerts
Application.DisplayAlerts = False

'set references up-front
Set MySheet = ThisWorkbook.Worksheets("Sheet1")

'identify the last row in column A and the last col in row 1
'then assign a range to contain the full data "block"
With MySheet
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    LastCol = .Range("A" & .Columns.Count).End(xlToLeft).Column
    Set MyRange = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))
End With

'apply autofilter to the range showing only dates
'older than 2016-05-02, then deleting
'all the visible rows except the header
With MyRange
    .AutoFilter Field:=1, Criteria1:="<2016-05-02"
    .SpecialCells(xlCellTypeVisible).Offset(1, 0).Resize(.Rows.Count).Rows.Delete
End With

'turn off autofilter safely
With MySheet
    .AutoFilterMode = False
    If .FilterMode = True Then
        .ShowAllData
    End If
End With

'turn alerts back on
Application.DisplayAlerts = True

End Sub

 

Bardzo dziękuję za pomoc.
 

1 odpowiedź

0 głosów
odpowiedź 10 maja 2017 przez Czachuu Obywatel (1,160 p.)
wybrane 10 maja 2017 przez karolina.n28
 
Najlepsza

Witam,

najprościej będzie zamknąć ten kod, który znalazłaś w pętli for each po arkuszach(z małymi zmianami):

Dim MySheet As Worksheet, MyRange As Range
Dim LastRow As Long, LastCol As Long
 
'turn off alerts
Application.DisplayAlerts = False
For Each MySheet In ActiveWorkbook.Worksheets
'set references up-front
'Set MySheet = ThisWorkbook.Worksheets("Sheet1")
 
'identify the last row in column A and the last col in row 1
'then assign a range to contain the full data "block"
    With MySheet
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        Set MyRange = .Range("A1:A" & LastRow)
    End With
     
    'apply autofilter to the range showing only dates
    'older than 2016-05-02, then deleting
    'all the visible rows except the header
    With MyRange
        .AutoFilter Field:=1, Criteria1:="<2017-05-02"
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete' jesli kolumna A ma nagłówek
    End With

     
    'turn off autofilter safely
    With MySheet
        .AutoFilterMode = False
        If .FilterMode = True Then
            .ShowAllData
        End If
    End With
Next
'turn alerts back on
Application.DisplayAlerts = True
 
End Sub

Pozdrawiam

komentarz 10 maja 2017 przez karolina.n28 Nowicjusz (240 p.)
Bardzo dziękuję za pomoc! :)

Podobne pytania

+1 głos
1 odpowiedź 386 wizyt
pytanie zadane 25 września 2020 w Visual Basic przez doeg Początkujący (430 p.)
0 głosów
0 odpowiedzi 1,215 wizyt
0 głosów
2 odpowiedzi 1,908 wizyt
pytanie zadane 10 maja 2017 w Visual Basic przez karolina.n28 Nowicjusz (240 p.)

92,775 zapytań

141,703 odpowiedzi

320,556 komentarzy

62,109 pasjonatów

Motyw:

Akcja Pajacyk

Pajacyk od wielu lat dożywia dzieci. Pomóż klikając w zielony brzuszek na stronie. Dziękujemy! ♡

Oto polecana książka warta uwagi.
Pełną listę książek znajdziesz tutaj.

Akademia Sekuraka

Niedawno wystartował dodruk tej świetnej, rozchwytywanej książki (około 940 stron). Mamy dla Was kod: pasja (wpiszcie go w koszyku), dzięki któremu otrzymujemy 10% zniżki - dziękujemy zaprzyjaźnionej ekipie Sekuraka za taki bonus dla Pasjonatów! Książka to pierwszy tom z serii o ITsec, który łagodnie wprowadzi w świat bezpieczeństwa IT każdą osobę - warto, polecamy!

...