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

Вход

Регистрация

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

 

= Мир MS Excel/Удаление лишних страниц с листа - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удаление лишних страниц с листа (Макросы/Sub)
Удаление лишних страниц с листа
gge29 Дата: Пятница, 19.08.2016, 22:09 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 244
Репутация: 3 ±
Замечаний: 0% ±

Подскажите пожалуйста,существует ли какой макрос по удалению лишних страниц
Есть данный табель кол-во страниц в нём каждый раз разное
в нём максимальное 40 страниц в формате A3.Для примера сделал 16 заполненных страниц,
в данном случае необходимо удалить с 18-39 и подставить последнюю 40
Последняя 40 страница всегда должна быть чётной
Товарищи модераторы простите
Как только не пытался сжать в 100kb не укладывается
пришлось на яндекс закинуть Удалено. Нарушение Правил форума


Сообщение отредактировал Pelena - Пятница, 19.08.2016, 22:21
 
Ответить
СообщениеПодскажите пожалуйста,существует ли какой макрос по удалению лишних страниц
Есть данный табель кол-во страниц в нём каждый раз разное
в нём максимальное 40 страниц в формате A3.Для примера сделал 16 заполненных страниц,
в данном случае необходимо удалить с 18-39 и подставить последнюю 40
Последняя 40 страница всегда должна быть чётной
Товарищи модераторы простите
Как только не пытался сжать в 100kb не укладывается
пришлось на яндекс закинуть Удалено. Нарушение Правил форума

Автор - gge29
Дата добавления - 19.08.2016 в 22:09
Pelena Дата: Пятница, 19.08.2016, 22:20 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 19161
Репутация: 4412 ±
Замечаний: ±

Excel 365 & Mac Excel
максимальное 40 страниц в формате A3. Для примера сделал 16 заполненных страниц

Зачем нам столько страниц? Сделайте в 10 раз меньше и выложите файл сюда.
[p.s.]И да, надеюсь там вымышленные фамилии и другие данные[/p.s.]


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщение
максимальное 40 страниц в формате A3. Для примера сделал 16 заполненных страниц

Зачем нам столько страниц? Сделайте в 10 раз меньше и выложите файл сюда.
[p.s.]И да, надеюсь там вымышленные фамилии и другие данные[/p.s.]

Автор - Pelena
Дата добавления - 19.08.2016 в 22:20
KuklP Дата: Пятница, 19.08.2016, 22:36 | Сообщение № 3
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
И желательно пояснить - как программа должна догадаться, какие страницы удалять.


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеИ желательно пояснить - как программа должна догадаться, какие страницы удалять.

Автор - KuklP
Дата добавления - 19.08.2016 в 22:36
gge29 Дата: Пятница, 19.08.2016, 22:37 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 244
Репутация: 3 ±
Замечаний: 0% ±

Елена,всё что смог удалил.
ну сейчас получается необходимо удалить 4,5,6 и подставить 7 последним,
должно получится 1,2,3,7
P.S.
И да, надеюсь там вымышленные фамилии и другие данные

Всё левое
К сообщению приложен файл: 1-_2016.xlsx (99.1 Kb)
 
Ответить
СообщениеЕлена,всё что смог удалил.
ну сейчас получается необходимо удалить 4,5,6 и подставить 7 последним,
должно получится 1,2,3,7
P.S.
И да, надеюсь там вымышленные фамилии и другие данные

Всё левое

Автор - gge29
Дата добавления - 19.08.2016 в 22:37
KuklP Дата: Пятница, 19.08.2016, 22:48 | Сообщение № 5
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
gge29, не надо писать мне в личку(если не собираетесь оплачивать мои услуги), для обсуждений есть этот форум. Что Вы расписали? Удалить от сих до сих? Не вопрос. Для первого примера(удаленного):
[vba]
Код
Public Sub www()
    ActiveSheet.Range((17 * 22 + 6) & ":" & (39 * 22 + 5)).Delete
End Sub
[/vba]
удалить 4,5,6 и подставить 7 последним

Последняя 40 страница всегда должна быть чётной
Вы хоть читаете, что пишете?


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
Сообщениеgge29, не надо писать мне в личку(если не собираетесь оплачивать мои услуги), для обсуждений есть этот форум. Что Вы расписали? Удалить от сих до сих? Не вопрос. Для первого примера(удаленного):
[vba]
Код
Public Sub www()
    ActiveSheet.Range((17 * 22 + 6) & ":" & (39 * 22 + 5)).Delete
End Sub
[/vba]
удалить 4,5,6 и подставить 7 последним

Последняя 40 страница всегда должна быть чётной
Вы хоть читаете, что пишете?

Автор - KuklP
Дата добавления - 19.08.2016 в 22:48
gge29 Дата: Пятница, 19.08.2016, 22:58 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 244
Репутация: 3 ±
Замечаний: 0% ±

Последняя 40 страница всегда должна быть чётной
Вы хоть читаете, что пишете?

Это было написано в 1 сообщении где в файле было 40 страниц,
у этого табеля каждый месяц разное кол-во страниц,максимальное 40
Например если из 40 заполнено 16 удалить надо с 18-39,а остаться должно 1-17+40(которая всегда чётная


Сообщение отредактировал gge29 - Пятница, 19.08.2016, 23:23
 
Ответить
Сообщение
Последняя 40 страница всегда должна быть чётной
Вы хоть читаете, что пишете?

Это было написано в 1 сообщении где в файле было 40 страниц,
у этого табеля каждый месяц разное кол-во страниц,максимальное 40
Например если из 40 заполнено 16 удалить надо с 18-39,а остаться должно 1-17+40(которая всегда чётная

Автор - gge29
Дата добавления - 19.08.2016 в 22:58
gge29 Дата: Пятница, 19.08.2016, 23:13 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 244
Репутация: 3 ±
Замечаний: 0% ±

Public Sub www()
ActiveSheet.Range((17 * 22 + 6) & ":" & (39 * 22 + 5)).Delete
End Sub

В данном коде вы в ручную указываете что удалить с 17,а если их не 16 заполненных а например 10
должно остаться 1-10+11 нечётная чистая + 40 чётная обложка


Сообщение отредактировал gge29 - Пятница, 19.08.2016, 23:13
 
Ответить
Сообщение
Public Sub www()
ActiveSheet.Range((17 * 22 + 6) & ":" & (39 * 22 + 5)).Delete
End Sub

В данном коде вы в ручную указываете что удалить с 17,а если их не 16 заполненных а например 10
должно остаться 1-10+11 нечётная чистая + 40 чётная обложка

Автор - gge29
Дата добавления - 19.08.2016 в 23:13
KuklP Дата: Суббота, 20.08.2016, 09:35 | Сообщение № 8
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Я Вас спрашивал:
И желательно пояснить - как программа должна догадаться, какие страницы удалять.

Вы ответили:
необходимо удалить 4,5,6 и подставить 7 последним
- это по-Вашему пояснение? Тогда мой макрос - исчерпывающее решение. Уже восьмое сообщение в теме(не считая лички), а Вы до сих пор внятно не сформулировали задачу. Ну, мне не настолько нечего делать, чтоб толочь тут воду в ступе :)


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеЯ Вас спрашивал:
И желательно пояснить - как программа должна догадаться, какие страницы удалять.

Вы ответили:
необходимо удалить 4,5,6 и подставить 7 последним
- это по-Вашему пояснение? Тогда мой макрос - исчерпывающее решение. Уже восьмое сообщение в теме(не считая лички), а Вы до сих пор внятно не сформулировали задачу. Ну, мне не настолько нечего делать, чтоб толочь тут воду в ступе :)

Автор - KuklP
Дата добавления - 20.08.2016 в 09:35
gling Дата: Суббота, 20.08.2016, 12:54 | Сообщение № 9
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2519
Репутация: 674 ±
Замечаний: 0% ±

2010
Здравствуйте. А обязательно удалять? Можно просто скрывать не нужные. В файле вариант с фильтром в столбце BS. Фильтр по 1, отобразит нужное, филтр по нулю ненужное, которое можно выделит и удалить строки.
К сообщению приложен файл: 1-2016.xlsx (96.5 Kb)


ЯД-41001506838083
 
Ответить
СообщениеЗдравствуйте. А обязательно удалять? Можно просто скрывать не нужные. В файле вариант с фильтром в столбце BS. Фильтр по 1, отобразит нужное, филтр по нулю ненужное, которое можно выделит и удалить строки.

Автор - gling
Дата добавления - 20.08.2016 в 12:54
gge29 Дата: Суббота, 20.08.2016, 18:11 | Сообщение № 10
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 244
Репутация: 3 ±
Замечаний: 0% ±

И желательно пояснить - как программа должна догадаться, какие страницы удалять.

Может быть как-то по 1 ячейки табеля(G77;G99;G121 и т.д.) если в ней 0 удалить страницу,если 1 или >0 оставить
Вариант Владимира
Можно просто скрывать не нужные.

не подходит оставляет много чистых и рамки пропадают
Смысл в том что последний лист должен быть всегда чётным
В оригинальном шаблоне 40 листов каждый под себя заполняет своих работников и сохраняет к себе на пк(шаблон остаётся не тронутым)
у всех разное кол-во заполненных страниц
если их не 16 заполненных а например 10
должно остаться 1-10+11 нечётная чистая станица с табелем + последняя чётная обложка

Может так понятнее расписал,уже даже не знаю как ещё объяснить
К сообщению приложен файл: 9856364.xlsx (99.1 Kb)
 
Ответить
Сообщение
И желательно пояснить - как программа должна догадаться, какие страницы удалять.

Может быть как-то по 1 ячейки табеля(G77;G99;G121 и т.д.) если в ней 0 удалить страницу,если 1 или >0 оставить
Вариант Владимира
Можно просто скрывать не нужные.

не подходит оставляет много чистых и рамки пропадают
Смысл в том что последний лист должен быть всегда чётным
В оригинальном шаблоне 40 листов каждый под себя заполняет своих работников и сохраняет к себе на пк(шаблон остаётся не тронутым)
у всех разное кол-во заполненных страниц
если их не 16 заполненных а например 10
должно остаться 1-10+11 нечётная чистая станица с табелем + последняя чётная обложка

Может так понятнее расписал,уже даже не знаю как ещё объяснить

Автор - gge29
Дата добавления - 20.08.2016 в 18:11
gge29 Дата: Суббота, 20.08.2016, 21:43 | Сообщение № 11
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 244
Репутация: 3 ±
Замечаний: 0% ±

Может подскажете как реализовать такой макрос если через ЕСЛИ даты в 0 переделать
[vba]
Код
Sub test()
    Application.ScreenUpdating = False    ' отключаем обновление экрана
    Dim sh As Worksheet: Set sh = ActiveSheet    ' Set sh = Sheets("MAKROS_EKSPIREMENT")
    Dim FirstCell As Range: Set FirstCell = sh.Range("G5")    ' первая ячейка
    ' берем диапазон до последней заполненной
    Dim ra As Range: Set ra = sh.Range(FirstCell, FirstCell.End(xlDown))
    ra.Value = ra.Value    ' преобразуем формулы в значения
    ra.Replace "0", vbNullString, xlWhole    ' очищаем ячейки с нулями
    On Error Resume Next
    ra.SpecialCells(xlCellTypeBlanks).EntireRow.Delete    ' удаляем строки, которые были с нулями

    sh.UsedRange.Value = sh.UsedRange.Value    ' преобразуем формулы в значения на всем листе

    ' удаляем строки с ошибками в первом столбце
    sh.Range("a:a").SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
End Sub
[/vba]
 
Ответить
СообщениеМожет подскажете как реализовать такой макрос если через ЕСЛИ даты в 0 переделать
[vba]
Код
Sub test()
    Application.ScreenUpdating = False    ' отключаем обновление экрана
    Dim sh As Worksheet: Set sh = ActiveSheet    ' Set sh = Sheets("MAKROS_EKSPIREMENT")
    Dim FirstCell As Range: Set FirstCell = sh.Range("G5")    ' первая ячейка
    ' берем диапазон до последней заполненной
    Dim ra As Range: Set ra = sh.Range(FirstCell, FirstCell.End(xlDown))
    ra.Value = ra.Value    ' преобразуем формулы в значения
    ra.Replace "0", vbNullString, xlWhole    ' очищаем ячейки с нулями
    On Error Resume Next
    ra.SpecialCells(xlCellTypeBlanks).EntireRow.Delete    ' удаляем строки, которые были с нулями

    sh.UsedRange.Value = sh.UsedRange.Value    ' преобразуем формулы в значения на всем листе

    ' удаляем строки с ошибками в первом столбце
    sh.Range("a:a").SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
End Sub
[/vba]

Автор - gge29
Дата добавления - 20.08.2016 в 21:43
gling Дата: Суббота, 20.08.2016, 22:29 | Сообщение № 12
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2519
Репутация: 674 ±
Замечаний: 0% ±

2010
Попробуйте вариант с формулой.[vba]
Код
Sub Листы()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Sheets("ТАБЕЛЬ").Copy After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "Цех №" & Range("G7").Value
    Sheets(Sheets.Count).Range("$BS$4:$BS$862").FormulaR1C1 = _
        "=IF(MOD((ROW()+17)/22,1),R[-1]C,IF(NOT(ISBLANK(R[6]C[-64])),INT((ROW()+17)/22),IF(ISEVEN(MAX(R4C71:R[-1]C)),INT((ROW()+17)/22),"""")))"
    Sheets(Sheets.Count).Range("$BS$863:$BS$884") = 40
    Calculate
    Columns("BS:BS").SpecialCells(xlCellTypeFormulas, 2).EntireRow.Delete
    Columns("BS:BS").ClearContents
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
[/vba]


ЯД-41001506838083
 
Ответить
СообщениеПопробуйте вариант с формулой.[vba]
Код
Sub Листы()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Sheets("ТАБЕЛЬ").Copy After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "Цех №" & Range("G7").Value
    Sheets(Sheets.Count).Range("$BS$4:$BS$862").FormulaR1C1 = _
        "=IF(MOD((ROW()+17)/22,1),R[-1]C,IF(NOT(ISBLANK(R[6]C[-64])),INT((ROW()+17)/22),IF(ISEVEN(MAX(R4C71:R[-1]C)),INT((ROW()+17)/22),"""")))"
    Sheets(Sheets.Count).Range("$BS$863:$BS$884") = 40
    Calculate
    Columns("BS:BS").SpecialCells(xlCellTypeFormulas, 2).EntireRow.Delete
    Columns("BS:BS").ClearContents
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
[/vba]

Автор - gling
Дата добавления - 20.08.2016 в 22:29
gge29 Дата: Суббота, 20.08.2016, 23:12 | Сообщение № 13
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 244
Репутация: 3 ±
Замечаний: 0% ±

Попробуйте вариант с формулой.

Владимир добрый вечер!!!
Попробовал Ваш вариант
создаёт лист и в ячейки BS вставляет формулу и присваивает № странице
как реализовать это на удаление, и ругается на строку
[vba]
Код
Columns("BS:BS").SpecialCells(xlCellTypeFormulas, 2).EntireRow.Delete
[/vba]
 
Ответить
Сообщение
Попробуйте вариант с формулой.

Владимир добрый вечер!!!
Попробовал Ваш вариант
создаёт лист и в ячейки BS вставляет формулу и присваивает № странице
как реализовать это на удаление, и ругается на строку
[vba]
Код
Columns("BS:BS").SpecialCells(xlCellTypeFormulas, 2).EntireRow.Delete
[/vba]

Автор - gge29
Дата добавления - 20.08.2016 в 23:12
gge29 Дата: Суббота, 20.08.2016, 23:20 | Сообщение № 14
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 244
Репутация: 3 ±
Замечаний: 0% ±

Если использовать фильтр для выделения листов появляются чистые листы перед последним
например у меня заполнено 16
я выделил с 1 по 16+17 чистый лист табеля+40(чётная18-я) и у меня между 17 и 40 8 чистых листов


Сообщение отредактировал gge29 - Суббота, 20.08.2016, 23:25
 
Ответить
СообщениеЕсли использовать фильтр для выделения листов появляются чистые листы перед последним
например у меня заполнено 16
я выделил с 1 по 16+17 чистый лист табеля+40(чётная18-я) и у меня между 17 и 40 8 чистых листов

Автор - gge29
Дата добавления - 20.08.2016 в 23:20
gling Дата: Суббота, 20.08.2016, 23:40 | Сообщение № 15
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2519
Репутация: 674 ±
Замечаний: 0% ±

2010
В вашем примере для чего то стоят нули в столбце G, где пишется ФИО уберите их, и на сороковом листе единицы уберите и попробуйте вновь. А ругается потому что не находит текст в ячейках столбца BS. Такое будет когда все листы будут заполнены. Наверно нужно прописать On Error Resume Next, чтобы не ругался.
В файле выделите Лист4 и нажмите 35 раз "вставить строки", получится 40 листов. Запустите макрос.
К сообщению приложен файл: 7198722.xlsm (91.7 Kb)


ЯД-41001506838083

Сообщение отредактировал gling - Суббота, 20.08.2016, 23:43
 
Ответить
СообщениеВ вашем примере для чего то стоят нули в столбце G, где пишется ФИО уберите их, и на сороковом листе единицы уберите и попробуйте вновь. А ругается потому что не находит текст в ячейках столбца BS. Такое будет когда все листы будут заполнены. Наверно нужно прописать On Error Resume Next, чтобы не ругался.
В файле выделите Лист4 и нажмите 35 раз "вставить строки", получится 40 листов. Запустите макрос.

Автор - gling
Дата добавления - 20.08.2016 в 23:40
gge29 Дата: Суббота, 20.08.2016, 23:58 | Сообщение № 16
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 244
Репутация: 3 ±
Замечаний: 0% ±

Владимир уже освоил Вашу версию,
через фильтр выбираю страницы,потом перевожу в pdf и всё отлично(офис подтупливал походу,т.к. принтер не установлен,а на другом пк отлично
Спасибо Вам за помощь!!!
 
Ответить
СообщениеВладимир уже освоил Вашу версию,
через фильтр выбираю страницы,потом перевожу в pdf и всё отлично(офис подтупливал походу,т.к. принтер не установлен,а на другом пк отлично
Спасибо Вам за помощь!!!

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

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