Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Удаление строк по дате - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удаление строк по дате (Макросы/Sub)
Удаление строк по дате
emkub Дата: Суббота, 05.03.2016, 20:21 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 87
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Здравствуйте. Просмотрел не только этот форум, но и много других сайтов. Решения не нашёл.
Суть. Есть файл с объявлениями, где отдельной колонкой идёт дата (формат 05.03.2016).
Что нужно: если макрос выполняется до 13.00 - то оставить только вчерашние строки, остальные удалить; если макрос выполняется после 13.00 - оставить только сегодняшние, остальные удалить.
Если нужно - приложу файл.
К сообщению приложен файл: 4186705.xlsx(9Kb)


Сообщение отредактировал emkub - Суббота, 05.03.2016, 22:00
 
Ответить
СообщениеЗдравствуйте. Просмотрел не только этот форум, но и много других сайтов. Решения не нашёл.
Суть. Есть файл с объявлениями, где отдельной колонкой идёт дата (формат 05.03.2016).
Что нужно: если макрос выполняется до 13.00 - то оставить только вчерашние строки, остальные удалить; если макрос выполняется после 13.00 - оставить только сегодняшние, остальные удалить.
Если нужно - приложу файл.

Автор - emkub
Дата добавления - 05.03.2016 в 20:21
al-Ex Дата: Суббота, 05.03.2016, 20:22 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 149
Репутация: 55 ±
Замечаний: 0% ±

Excel 2010
Если нужно - приложу файл.
нужно
 
Ответить
Сообщение
Если нужно - приложу файл.
нужно

Автор - al-Ex
Дата добавления - 05.03.2016 в 20:22
StoTisteg Дата: Суббота, 05.03.2016, 21:29 | Сообщение № 3
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
[vba]
Код
Sub Сортировка()

    Cells(1, 11).Value = "Надо"
    Cells(1, 12).Value = "Надо"
    Range(Cells(2, 11), Cells(Cells(Rows.Count, 9).End(xlUp).Row, 11)).FormulaR1C1 = "=DAY(RC[-3])=DAY(TODAY())"
    If Hour(Now) > 13 Then
        Cells(2, 12).Value = True
        Else
            Cells(2, 12).Value = False
    End If
    ActiveSheet.UsedRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range(Cells(1, 12), Cells(2, 12)), CopyToRange:=Cells(1, 14), Unique:=False
    Columns("G:M").Delete
    Columns("K:L").Delete
        
End Sub
[/vba]
Обратите внимание на добавленный мной заголовок — он необходим для работы AdvancedFilter
К сообщению приложен файл: CritDat.xlsm(16Kb)


Проверь всё. ThisWorkbook.Save. On Error Resume Next.

Сообщение отредактировал StoTisteg - Суббота, 05.03.2016, 21:39
 
Ответить
Сообщение[vba]
Код
Sub Сортировка()

    Cells(1, 11).Value = "Надо"
    Cells(1, 12).Value = "Надо"
    Range(Cells(2, 11), Cells(Cells(Rows.Count, 9).End(xlUp).Row, 11)).FormulaR1C1 = "=DAY(RC[-3])=DAY(TODAY())"
    If Hour(Now) > 13 Then
        Cells(2, 12).Value = True
        Else
            Cells(2, 12).Value = False
    End If
    ActiveSheet.UsedRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range(Cells(1, 12), Cells(2, 12)), CopyToRange:=Cells(1, 14), Unique:=False
    Columns("G:M").Delete
    Columns("K:L").Delete
        
End Sub
[/vba]
Обратите внимание на добавленный мной заголовок — он необходим для работы AdvancedFilter

Автор - StoTisteg
Дата добавления - 05.03.2016 в 21:29
emkub Дата: Суббота, 05.03.2016, 21:46 | Сообщение № 4
Группа: Пользователи
Ранг: Участник
Сообщений: 87
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Заранее не подумал про такой вариант... Мой промах. Отредактировал файл примера. Во всех ячейках (до столбца U) есть данные, так что перенос и удаление столбцов - не вариант... Да и количество строк заранее не определено, может достигать 1000, а то и больше.
 
Ответить
СообщениеЗаранее не подумал про такой вариант... Мой промах. Отредактировал файл примера. Во всех ячейках (до столбца U) есть данные, так что перенос и удаление столбцов - не вариант... Да и количество строк заранее не определено, может достигать 1000, а то и больше.

Автор - emkub
Дата добавления - 05.03.2016 в 21:46
StoTisteg Дата: Суббота, 05.03.2016, 22:09 | Сообщение № 5
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
Во всех ячейках (до столбца U) есть данные

Ну так отредактируйте код так, чтобы копировалось туда, где их нет. Конкретно — везде, где Cells(1,11) и т. п. вторая цифра — номер второго полностью свободного столбца, Cells(1,12) — третьего. Columns("G:M").Delete можно заменить на Columns("A:<Буква_следующего_последним_занятым_столбца>").Delete Columns("K:L").Delete — на буквы второго и третьего свободных столбцов. Я не могу заглянуть в Ваш "боевой" файл.

количество строк заранее не определено

Это предусмотрено в ActiveSheet.UsedRange.
И повторю Вам ещё раз — заголовки должны быть, я их за Вас придумывать не буду. могу только вставить и удалить. Где-то так:
[vba]
Код
Sub Сортировка()

    Dim i As Integer
    
    Rows(1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    For i = 1 To 21
        Cells(1, i).Value = "Абырвалг" & i
    Next i
    Cells(1, 23).Value = "Надо"
    Cells(1, 24).Value = "Надо"
    Range(Cells(2, 23), Cells(Cells(Rows.Count, 9).End(xlUp).Row, 23)).FormulaR1C1 = "=DAY(RC[-15])=DAY(TODAY())"
    If Hour(Now) > 13 Then
        Cells(2, 24).Value = True
        Else
            Cells(2, 24).Value = False
    End If
    ActiveSheet.UsedRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range(Cells(1, 24), Cells(2, 24)), CopyToRange:=Cells(1, 26), Unique:=False
    Rows(1).Delete
    Columns("A:V").Delete
    Columns("W:X").Delete
    Columns("A:U").EntireColumn.AutoFit
        
End Sub
[/vba]


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
Сообщение
Во всех ячейках (до столбца U) есть данные

Ну так отредактируйте код так, чтобы копировалось туда, где их нет. Конкретно — везде, где Cells(1,11) и т. п. вторая цифра — номер второго полностью свободного столбца, Cells(1,12) — третьего. Columns("G:M").Delete можно заменить на Columns("A:<Буква_следующего_последним_занятым_столбца>").Delete Columns("K:L").Delete — на буквы второго и третьего свободных столбцов. Я не могу заглянуть в Ваш "боевой" файл.

количество строк заранее не определено

Это предусмотрено в ActiveSheet.UsedRange.
И повторю Вам ещё раз — заголовки должны быть, я их за Вас придумывать не буду. могу только вставить и удалить. Где-то так:
[vba]
Код
Sub Сортировка()

    Dim i As Integer
    
    Rows(1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    For i = 1 To 21
        Cells(1, i).Value = "Абырвалг" & i
    Next i
    Cells(1, 23).Value = "Надо"
    Cells(1, 24).Value = "Надо"
    Range(Cells(2, 23), Cells(Cells(Rows.Count, 9).End(xlUp).Row, 23)).FormulaR1C1 = "=DAY(RC[-15])=DAY(TODAY())"
    If Hour(Now) > 13 Then
        Cells(2, 24).Value = True
        Else
            Cells(2, 24).Value = False
    End If
    ActiveSheet.UsedRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range(Cells(1, 24), Cells(2, 24)), CopyToRange:=Cells(1, 26), Unique:=False
    Rows(1).Delete
    Columns("A:V").Delete
    Columns("W:X").Delete
    Columns("A:U").EntireColumn.AutoFit
        
End Sub
[/vba]

Автор - StoTisteg
Дата добавления - 05.03.2016 в 22:09
SLAVICK Дата: Суббота, 05.03.2016, 22:10 | Сообщение № 6
Группа: Модераторы
Ранг: Старожил
Сообщений: 1849
Репутация: 614 ±
Замечаний: 0% ±

2007,2010,2013,2016
Может так:
[vba]
Код
Sub d()
Dim d As Date, n&, i&, r As Range
If Hour(Now) > 13 Then d = Date Else d = Date - 1
n = Cells(Rows.Count, "h").End(xlUp).Row

    For i = 1 To n
        If CDate(Cells(i, "h")) <> d Then If r Is Nothing Then Set r = Cells(i, "h").EntireRow Else Set r = Union(r, Cells(i, "h").EntireRow)
    Next
    r.Delete Shift:=xlUp
End Sub
[/vba]

И не нужно никаких допстолбцов, фильтров ... ;)
К сообщению приложен файл: 4186705.xlsm(18Kb)


Иногда все проще чем кажется с первого взгляда.
 
Ответить
СообщениеМожет так:
[vba]
Код
Sub d()
Dim d As Date, n&, i&, r As Range
If Hour(Now) > 13 Then d = Date Else d = Date - 1
n = Cells(Rows.Count, "h").End(xlUp).Row

    For i = 1 To n
        If CDate(Cells(i, "h")) <> d Then If r Is Nothing Then Set r = Cells(i, "h").EntireRow Else Set r = Union(r, Cells(i, "h").EntireRow)
    Next
    r.Delete Shift:=xlUp
End Sub
[/vba]

И не нужно никаких допстолбцов, фильтров ... ;)

Автор - SLAVICK
Дата добавления - 05.03.2016 в 22:10
StoTisteg Дата: Суббота, 05.03.2016, 22:19 | Сообщение № 7
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
SLAVICK, ну привычка у меня такая yes У меня обычно строк дофига, файлов тоже и перебирать все строки подряд — затея на пол-рабочего дня :)


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
СообщениеSLAVICK, ну привычка у меня такая yes У меня обычно строк дофига, файлов тоже и перебирать все строки подряд — затея на пол-рабочего дня :)

Автор - StoTisteg
Дата добавления - 05.03.2016 в 22:19
Manyasha Дата: Суббота, 05.03.2016, 22:21 | Сообщение № 8
Группа: Модераторы
Ранг: Старожил
Сообщений: 1590
Репутация: 669 ±
Замечаний: 0% ±

Excel 2007, 2010
ну и еще вариант, раз уж написала:
[vba]
Код
Sub ее()
    Dim d As Date
    If Hour(Now) <= 13 Then
        d = Date - 1
        constSort = 1
    Else
        d = Date
        constSort = 2
    End If
    lr = Cells(Rows.Count, "h").End(xlUp).Row
    lc = ActiveSheet.UsedRange.Columns.Count
    kol = WorksheetFunction.CountIf(Range("h1:h" & lr), d)
    With ActiveSheet.Sort.SortFields
        .Clear
        .Add Key:=Range("h1:h" & lr), Order:=constSort
    End With
    With ActiveSheet.Sort
        .SetRange ActiveSheet.UsedRange
        .Header = xlGuess: .Apply
    End With
    Rows(kol + 1 & ":" & lr).Delete
End Sub
[/vba]
К сообщению приложен файл: 4186705-1.xlsm(16Kb)


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804


Сообщение отредактировал Manyasha - Суббота, 05.03.2016, 23:25
 
Ответить
Сообщениену и еще вариант, раз уж написала:
[vba]
Код
Sub ее()
    Dim d As Date
    If Hour(Now) <= 13 Then
        d = Date - 1
        constSort = 1
    Else
        d = Date
        constSort = 2
    End If
    lr = Cells(Rows.Count, "h").End(xlUp).Row
    lc = ActiveSheet.UsedRange.Columns.Count
    kol = WorksheetFunction.CountIf(Range("h1:h" & lr), d)
    With ActiveSheet.Sort.SortFields
        .Clear
        .Add Key:=Range("h1:h" & lr), Order:=constSort
    End With
    With ActiveSheet.Sort
        .SetRange ActiveSheet.UsedRange
        .Header = xlGuess: .Apply
    End With
    Rows(kol + 1 & ":" & lr).Delete
End Sub
[/vba]

Автор - Manyasha
Дата добавления - 05.03.2016 в 22:21
SLAVICK Дата: Суббота, 05.03.2016, 22:48 | Сообщение № 9
Группа: Модераторы
Ранг: Старожил
Сообщений: 1849
Репутация: 614 ±
Замечаний: 0% ±

2007,2010,2013,2016
У меня обычно строк дофига

Не поверите - у меня тоже :D
и перебирать все строки подряд — затея на пол-рабочего дня

А Вы попробуйте этот код - сравните с Вашим - какой быстрее? ;)

Сразу стоит сказать, что этот код будет работать до 8192 независимых диапазонов. Если строк больше 10 000 - лучше пользоваться алгоритмом как в этой теме.

StoTisteg, AdvancedFilter - очень тормозит - поэтому я обхожу его стороной, сортировка в разы быстрее :D


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение
У меня обычно строк дофига

Не поверите - у меня тоже :D
и перебирать все строки подряд — затея на пол-рабочего дня

А Вы попробуйте этот код - сравните с Вашим - какой быстрее? ;)

Сразу стоит сказать, что этот код будет работать до 8192 независимых диапазонов. Если строк больше 10 000 - лучше пользоваться алгоритмом как в этой теме.

StoTisteg, AdvancedFilter - очень тормозит - поэтому я обхожу его стороной, сортировка в разы быстрее :D

Автор - SLAVICK
Дата добавления - 05.03.2016 в 22:48
emkub Дата: Суббота, 05.03.2016, 22:58 | Сообщение № 10
Группа: Пользователи
Ранг: Участник
Сообщений: 87
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
SLAVICK, я как раз и думал именно о такой "логике" процесса. Жаль пока не могу сам писать на VBA. Единственное, что по макросу - он спотыкается о заголовок столбца, выдаёт ошибку.
Manyasha, Ваш код пока не опробовал.
 
Ответить
СообщениеSLAVICK, я как раз и думал именно о такой "логике" процесса. Жаль пока не могу сам писать на VBA. Единственное, что по макросу - он спотыкается о заголовок столбца, выдаёт ошибку.
Manyasha, Ваш код пока не опробовал.

Автор - emkub
Дата добавления - 05.03.2016 в 22:58
StoTisteg Дата: Суббота, 05.03.2016, 22:58 | Сообщение № 11
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
StoTisteg, AdvancedFilter - очень тормозит

Но если критериев больше одного (а у меня это обычное дело), то сортировка проиграет просто из-за количества проходов :p


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
Сообщение
StoTisteg, AdvancedFilter - очень тормозит

Но если критериев больше одного (а у меня это обычное дело), то сортировка проиграет просто из-за количества проходов :p

Автор - StoTisteg
Дата добавления - 05.03.2016 в 22:58
SLAVICK Дата: Суббота, 05.03.2016, 23:12 | Сообщение № 12
Группа: Модераторы
Ранг: Старожил
Сообщений: 1849
Репутация: 614 ±
Замечаний: 0% ±

2007,2010,2013,2016
Единственное, что по макросу - он спотыкается о заголовок столбца, выдаёт ошибку.

Какой пример - такой и код :D - а если серьезно - сколько строк у Вас в шапке?
Если 1 то поменяйте строку
[vba]
Код
For i = 1 To n
[/vba]на
[vba]
Код
For i = 2 To n
[/vba]Если 2 на[vba]
Код
For i = 3 To n
[/vba]
и т.д (т.е. количество строк шапки+1)...

Manyasha, Ваш код на вложенном примере - немного не то сортирует - видимо из за UsedRange со столбца В :o
то сортировка проиграет просто из-за количества проходов

Так сортировку можно и одним проходом делать yes :
Данные -- сортировка -- добавить уровень


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение
Единственное, что по макросу - он спотыкается о заголовок столбца, выдаёт ошибку.

Какой пример - такой и код :D - а если серьезно - сколько строк у Вас в шапке?
Если 1 то поменяйте строку
[vba]
Код
For i = 1 To n
[/vba]на
[vba]
Код
For i = 2 To n
[/vba]Если 2 на[vba]
Код
For i = 3 To n
[/vba]
и т.д (т.е. количество строк шапки+1)...

Manyasha, Ваш код на вложенном примере - немного не то сортирует - видимо из за UsedRange со столбца В :o
то сортировка проиграет просто из-за количества проходов

Так сортировку можно и одним проходом делать yes :
Данные -- сортировка -- добавить уровень

Автор - SLAVICK
Дата добавления - 05.03.2016 в 23:12
Manyasha Дата: Суббота, 05.03.2016, 23:26 | Сообщение № 13
Группа: Модераторы
Ранг: Старожил
Сообщений: 1590
Репутация: 669 ±
Замечаний: 0% ±

Excel 2007, 2010
не то сортирует

ага, уже увидела.
Код поправила в сообщении выше, файл перевложила.


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщение
не то сортирует

ага, уже увидела.
Код поправила в сообщении выше, файл перевложила.

Автор - Manyasha
Дата добавления - 05.03.2016 в 23:26
StoTisteg Дата: Суббота, 05.03.2016, 23:29 | Сообщение № 14
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
Так сортировку можно и одним проходом делать :Данные -- сортировка -- добавить уровень

Ладно, уели :) В конце концов это Вы профи, а я просто ленивый экономист, предпочитающий ваять быдлокод вместо однообразной обработки 100500 листов yes


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
Сообщение
Так сортировку можно и одним проходом делать :Данные -- сортировка -- добавить уровень

Ладно, уели :) В конце концов это Вы профи, а я просто ленивый экономист, предпочитающий ваять быдлокод вместо однообразной обработки 100500 листов yes

Автор - StoTisteg
Дата добавления - 05.03.2016 в 23:29
emkub Дата: Суббота, 05.03.2016, 23:39 | Сообщение № 15
Группа: Пользователи
Ранг: Участник
Сообщений: 87
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Друзья, вы все гении :)
Всем огромное спасибо за участие и советы!!! Взял на вооружение код SLAVICKA.
 
Ответить
СообщениеДрузья, вы все гении :)
Всем огромное спасибо за участие и советы!!! Взял на вооружение код SLAVICKA.

Автор - emkub
Дата добавления - 05.03.2016 в 23:39
SLAVICK Дата: Суббота, 05.03.2016, 23:49 | Сообщение № 16
Группа: Модераторы
Ранг: Старожил
Сообщений: 1849
Репутация: 614 ±
Замечаний: 0% ±

2007,2010,2013,2016
[offtop]
В конце концов это Вы профи, а я просто ленивый экономист

Так я же тоже такой был - а во многом и до сих пор такой yes . Многому научился именно благодаря форумам.
предпочитающий ваять быдлокод вместо однообразной обработки

ВЫ через чур самокритичны :D - со временем научитесь выбирать нужный пример из своей копилки.
Для этого форумы - отличный способ тренироваться. А если и ошибетесь - то это не работа - никто не оштрафует ;) [/offtop]


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение[offtop]
В конце концов это Вы профи, а я просто ленивый экономист

Так я же тоже такой был - а во многом и до сих пор такой yes . Многому научился именно благодаря форумам.
предпочитающий ваять быдлокод вместо однообразной обработки

ВЫ через чур самокритичны :D - со временем научитесь выбирать нужный пример из своей копилки.
Для этого форумы - отличный способ тренироваться. А если и ошибетесь - то это не работа - никто не оштрафует ;) [/offtop]

Автор - SLAVICK
Дата добавления - 05.03.2016 в 23:49
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удаление строк по дате (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!