Здравствуйте. Просмотрел не только этот форум, но и много других сайтов. Решения не нашёл. Суть. Есть файл с объявлениями, где отдельной колонкой идёт дата (формат 05.03.2016). Что нужно: если макрос выполняется до 13.00 - то оставить только вчерашние строки, остальные удалить; если макрос выполняется после 13.00 - оставить только сегодняшние, остальные удалить. Если нужно - приложу файл.
Здравствуйте. Просмотрел не только этот форум, но и много других сайтов. Решения не нашёл. Суть. Есть файл с объявлениями, где отдельной колонкой идёт дата (формат 05.03.2016). Что нужно: если макрос выполняется до 13.00 - то оставить только вчерашние строки, остальные удалить; если макрос выполняется после 13.00 - оставить только сегодняшние, остальные удалить. Если нужно - приложу файл.emkub
Заранее не подумал про такой вариант... Мой промах. Отредактировал файл примера. Во всех ячейках (до столбца U) есть данные, так что перенос и удаление столбцов - не вариант... Да и количество строк заранее не определено, может достигать 1000, а то и больше.
Заранее не подумал про такой вариант... Мой промах. Отредактировал файл примера. Во всех ячейках (до столбца U) есть данные, так что перенос и удаление столбцов - не вариант... Да и количество строк заранее не определено, может достигать 1000, а то и больше.emkub
Ну так отредактируйте код так, чтобы копировалось туда, где их нет. Конкретно — везде, где 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
Ну так отредактируйте код так, чтобы копировалось туда, где их нет. Конкретно — везде, где 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
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]
И не нужно никаких допстолбцов, фильтров ...
Может так: [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
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]
ну и еще вариант, раз уж написала: [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
и перебирать все строки подряд — затея на пол-рабочего дня
А Вы попробуйте этот код - сравните с Вашим - какой быстрее?
Сразу стоит сказать, что этот код будет работать до 8192 независимых диапазонов. Если строк больше 10 000 - лучше пользоваться алгоритмом как в этой теме.
StoTisteg, AdvancedFilter - очень тормозит - поэтому я обхожу его стороной, сортировка в разы быстрее
и перебирать все строки подряд — затея на пол-рабочего дня
А Вы попробуйте этот код - сравните с Вашим - какой быстрее?
Сразу стоит сказать, что этот код будет работать до 8192 независимых диапазонов. Если строк больше 10 000 - лучше пользоваться алгоритмом как в этой теме.
StoTisteg, AdvancedFilter - очень тормозит - поэтому я обхожу его стороной, сортировка в разы быстрее SLAVICK
SLAVICK, я как раз и думал именно о такой "логике" процесса. Жаль пока не могу сам писать на VBA. Единственное, что по макросу - он спотыкается о заголовок столбца, выдаёт ошибку. Manyasha, Ваш код пока не опробовал.
SLAVICK, я как раз и думал именно о такой "логике" процесса. Жаль пока не могу сам писать на VBA. Единственное, что по макросу - он спотыкается о заголовок столбца, выдаёт ошибку. Manyasha, Ваш код пока не опробовал.emkub
Так сортировку можно и одним проходом делать :Данные -- сортировка -- добавить уровень
Ладно, уели В конце концов это Вы профи, а я просто ленивый экономист, предпочитающий ваять быдлокод вместо однообразной обработки 100500 листов StoTisteg
Интуитивно понятный код - это когда интуитивно понятно, что это код.
предпочитающий ваять быдлокод вместо однообразной обработки
ВЫ через чур самокритичны - со временем научитесь выбирать нужный пример из своей копилки. Для этого форумы - отличный способ тренироваться. А если и ошибетесь - то это не работа - никто не оштрафует [/offtop]
предпочитающий ваять быдлокод вместо однообразной обработки
ВЫ через чур самокритичны - со временем научитесь выбирать нужный пример из своей копилки. Для этого форумы - отличный способ тренироваться. А если и ошибетесь - то это не работа - никто не оштрафует [/offtop]SLAVICK