Удаление ячеек со смещением вниз

[СтаСС]

Сообщение от IgorGO

СтаСС, без обид

Все правильно, понятно что никаких обид и в помине нет и да - всестороннее знание своей задачи часто и мешает.. казалось бы мелочи которые как бы понятны по умолчанию на поверку могут оказаться не только непонятны другим но и совсем даже не мелочью. Так что согласен на все 100.

[СтаСС]

Макрос SAS888 отлично справляется со своей задачей, но теперь понадобилось использовать его на лисах в которых есть закрашенные ячейки и как "подшаманить" макрос так чтоб ячейки сохранили свою окраску я не знаю.. Help me!!!

макрос SAS888

Private Sub CommandButton1_Click()
    Dim x As Range, y As Range, z As Range, w As Range, q
    Application.ScreenUpdating = False
    Set x = [A3:T12] 'Диапазон значений
    For Each q In Array(0, 1): x.Replace q, "", xlWhole: Next
    Set y = x.Offset(ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count, 1)
    y.Value = x.Value: Set z = y.Cells(1).Offset(, -1): z = 1
    z.AutoFill z.Resize(y.Rows.Count), Type:=xlFillSeries
    Set w = z.Resize(y.Rows.Count, y.Columns.Count + 1)
    w.Sort Key1:=w.Cells(1), Order1:=xlDescending, Header:=xlNo
    On Error Resume Next: y.SpecialCells(4).Delete xlUp: On Error GoTo 0
    w.Sort Key1:=w.Cells(1), Order1:=xlAscending, Header:=xlNo
    x.Value = y.Value: y.EntireRow.Delete
End Sub

[SAS888]

Можно, например, так:

Private Sub CommandButton1_Click()
    Dim x As Range, y As Range, q: Application.ScreenUpdating = False
    Set x = [A3:T12]
    For Each q In Array(0, 1): x.Replace q, "", xlWhole: Next
    On Error Resume Next: x.SpecialCells(4).Delete xlUp
    For Each y In x.Columns: y.Cut y.Offset(Application.CountIf(y, "")): Next
End Sub

Но, следует иметь ввиду, что при копировании и вставке, будет перемещаться не только заливка, но и другие свойства ячеек (формат, границы, шрифт и т. д.).
Так, например, если таблица будет с прорисованными границами, то они "поедут" вместе с удаляемыми ячейками в каждом столбце. Поэтому, после удаления требуемых ячеек, возможно потребуется перерисовка границ таблицы.
Пример во вложении.

[СтаСС]

Сообщение от SAS888

Можно, например, так:

И снова огромное спасибо!!!
P.S. На обрабатываемых листах нет не таблиц не границ, только "голые" данные поэтому всё работает отлично.

[СтаСС]

Обнаружился небольшой минус а именно диапазон

Сообщение от SAS888

Set x = [A3:T12

в нужном листе начало можно определить а вот с окончанием сложнее.. дело в том что данные добавляются каждый день, а значит прийдется незабывать менять диапазон в макросе, что неочень надежно.. попробовал сделать "с запасом" но тогда все данные "сьезжают".. а можно как-то сделать чтоб макрос запрашивал "нижний" диапазон или чтоб работал до последней заполненой строки?

[SAS888]

Можно так:

Private Sub CommandButton1_Click()
    Dim x As Range, y As Range, i As Long, j As Long, q
    Application.ScreenUpdating = False
    i = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
    j = Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
    Set x = Range([A3], Cells(i, j))
    For Each q In Array(0, 1): x.Replace q, "", xlWhole: Next
    On Error Resume Next: x.SpecialCells(4).Delete xlUp
    For Each y In x.Columns: y.Cut y.Offset(Application.CountIf(y, "")): Next
End Sub

[СтаСС]

Сообщение от SAS888

Можно так:

Удаляет ненужные ячейки но смещяет все данные.. вот сделал PRIMER более схожим на нужный оригинал. В нем последняя заполненая строка 500-я,
а при выполнении макроса все данные смещаются и последней заполненой строко становится почему-то 91-я.. а надо чтоб она оставалась на месте т.е. 500-й..

[СтаСС]

Дико извиняюсь! Вторая бессонная ночь дает знать... я не поменял начало диапазона... а поменяв все отлично заработало
Еще раз сорри и СПАСИБО!

[SAS888]

Это потому, что в Вашем примере первая строка диапазона с данными - это 471.
А в макросе прописано

Set x = Range([A3], Cells(i, j))

т. е. 3-я строка.
Если [A3] заменить на [A471], то все будет нормально.
Если с последней ячейкой диапазона мы разобрались, то остается вопрос: как определить первую?
Укажите, по какому критерию определять первую строку диапазона с данными.
Может считать, что все ячейки выше есть пустые?

[СтаСС]

За первую строку я уже извинился и она всегда одна поэтому там проблем нет - ввел значение один раз и всё окей.
Извините что отнял у вас столько времени, чуть позже попробую макрос на всех нужных листах и надеюсь новых вопросов у меня уже небудет ))
Спасибо!!


P.S. Проверил на всех листах - макрос работает без проблем. Вопрос снят окончательно! Спасибо!!!