Всем доброго времени суток!!!Поступила вводная от шефа: создать таблички по участкам для работы в них разных менагеров.Таблички одинаковые , только даты запуска и окончания во всех таблицах разные. Необходимо из одной таблицы на 20000 строк вытащить только те строки, в которых в столбце V стоит какое либо значение в 4 книги: Заготовка ; Механика; Сварка; Сборка. При чем диапазон под группировкой переносить не надо.Переносить надо с форматами и формулами. [p.s.]я конечно мог бы и формулами, но на такой объем тормоза будут жуткими
Всем доброго времени суток!!!Поступила вводная от шефа: создать таблички по участкам для работы в них разных менагеров.Таблички одинаковые , только даты запуска и окончания во всех таблицах разные. Необходимо из одной таблицы на 20000 строк вытащить только те строки, в которых в столбце V стоит какое либо значение в 4 книги: Заготовка ; Механика; Сварка; Сборка. При чем диапазон под группировкой переносить не надо.Переносить надо с форматами и формулами. [p.s.]я конечно мог бы и формулами, но на такой объем тормоза будут жуткими китин
Игорь, я правильно понимаю, что это разовая работа? Если да, то просто скопируй книгу 3 раза, поставь ручной пересчет, поставь автофильтры <>Сборка в материале и Пусто в Апреле, выдели и удали строки. Сними автофильтры. Диапазоны под группировкой удали. На каждую книгу уйдет 2-3 минуты. Дольше с макросом или формулами возиться будешь.
Игорь, я правильно понимаю, что это разовая работа? Если да, то просто скопируй книгу 3 раза, поставь ручной пересчет, поставь автофильтры <>Сборка в материале и Пусто в Апреле, выдели и удали строки. Сними автофильтры. Диапазоны под группировкой удали. На каждую книгу уйдет 2-3 минуты. Дольше с макросом или формулами возиться будешь._Boroda_
Саш нет.Это работа (как хочет шеф) будет постоянная. Потом надо будет еще наладить связи между книгами, что бы данные передавались последовательно из заготовки в механику, потом в сварку потом в сборку Я бы не заморачивал вас с макросом из за простого создания 4 копий
Саш нет.Это работа (как хочет шеф) будет постоянная. Потом надо будет еще наладить связи между книгами, что бы данные передавались последовательно из заготовки в механику, потом в сварку потом в сборку Я бы не заморачивал вас с макросом из за простого создания 4 копий китин
Не судите очень строго:я пытаюсь научиться ЯД 41001877306852
данные передавались последовательно из заготовки в механику, потом в сварку потом в сборку
Уууууу! А не проще все в одном вести, а когда надо только кусок показать, то делить его, уж если так хочется? Ты ж повесишься взаимосвязи прописывать._Boroda_
Да по всякому думал: и одну книгу в общий доступ повесить, но тогда количество строк придется в 4 раза увеличивать.на каждую деталь 4 строчки.а на работе у диспетчеров компы чуть ли не Спектрумы стоят.Не потянут. Решил, что проще так: одна таблица со всеми формулами у меня(автоматом разбивает план на месяц по изделиям, деталям и заготовкам на каждый день месяца).в 4 таблицы переносятся данные для каждого диспетчера уже без формул, только значения и форматы. Но ессно при каждом изменении плана у диспетчеров должны появляться эти изменения.А между ними уже должны переходить детали после окончания каждой операции. [p.s.]новая мет... шеф так видит поэтапное планирование производства
Да по всякому думал: и одну книгу в общий доступ повесить, но тогда количество строк придется в 4 раза увеличивать.на каждую деталь 4 строчки.а на работе у диспетчеров компы чуть ли не Спектрумы стоят.Не потянут. Решил, что проще так: одна таблица со всеми формулами у меня(автоматом разбивает план на месяц по изделиям, деталям и заготовкам на каждый день месяца).в 4 таблицы переносятся данные для каждого диспетчера уже без формул, только значения и форматы. Но ессно при каждом изменении плана у диспетчеров должны появляться эти изменения.А между ними уже должны переходить детали после окончания каждой операции. [p.s.]новая мет... шеф так видит поэтапное планирование производствакитин
Не судите очень строго:я пытаюсь научиться ЯД 41001877306852
Сообщение отредактировал китин - Вторник, 29.03.2016, 15:36
я конечно мог бы и формулами, но на такой объем тормоза будут жуткими
я в таких случаях оставляю формулу только в верхней строке - а дальше макросом: "протягиваю" формулы по очереди по столбцам до нужной строки "убиваю" формулы ниже этой первой строки.
Т.е. если поставить фильтр в колонке v на больше 0, то: нужно перенести только видимые ячейки в диапазоне "B15:e..." и "u15:al..." так или еще чего?
И куда вставлять? - скиньте архив со всеми книгами(примеры) и выделите цветом что переносить - а то не понятно.
я конечно мог бы и формулами, но на такой объем тормоза будут жуткими
я в таких случаях оставляю формулу только в верхней строке - а дальше макросом: "протягиваю" формулы по очереди по столбцам до нужной строки "убиваю" формулы ниже этой первой строки.SLAVICK
Привет Слава.Да перенести ячейки А1:Е30 и W1:BN30 в новые книги. Скажем заготовка сборка сварка и механика.Попробовал копипастом.формулы убивает УФ смещается и не работает.А начальству охота все цветным видеть.
Привет Слава.Да перенести ячейки А1:Е30 и W1:BN30 в новые книги. Скажем заготовка сборка сварка и механика.Попробовал копипастом.формулы убивает УФ смещается и не работает.А начальству охота все цветным видеть.китин
Не судите очень строго:я пытаюсь научиться ЯД 41001877306852
Sub d() Dim n&, wb As Workbook, awb As Workbook, wbN, n1 Set awb = ThisWorkbook On Error Resume Next With awb.Sheets(1) n = .Cells(.Rows.Count, 2).End(xlUp).Row .ShowAllData .Range("$A$14:$BN$" & n).AutoFilter Field:=22, Criteria1:="<1", Operator:=xlAnd .Range("$A$15:$a$" & n).SpecialCells(xlCellTypeVisible).EntireRow.Delete .ShowAllData n = .Cells(.Rows.Count, 2).End(xlUp).Row End With For Each wbN In Array("сварка.xlsx", "сборка.xlsx", "механика.xlsx")
Set wb = Workbooks.Open(awb.Path & "\" & wbN)
With wb.Sheets(1) n1 = .Cells(.Rows.Count, 1).SpecialCells(xlLastCell).Row .Rows("15:" & n1).Clear awb.Sheets(1).Range("A15:E" & n).Copy: .Range("A15").PasteSpecial Paste:=xlPasteValues awb.Sheets(1).Range("W15:BN" & n).Copy: .Range("w15").PasteSpecial Paste:=xlPasteValues awb.Sheets(1).Range("a15:BN" & n).Copy: .Range("a15").PasteSpecial Paste:=xlPasteFormats End With Application.CutCopyMode = False wb.Close True Next End Sub
[/vba] Макрос в файле форум. Файл форум - потом закрывайте без сохранения
Так?: [vba]
Код
Sub d() Dim n&, wb As Workbook, awb As Workbook, wbN, n1 Set awb = ThisWorkbook On Error Resume Next With awb.Sheets(1) n = .Cells(.Rows.Count, 2).End(xlUp).Row .ShowAllData .Range("$A$14:$BN$" & n).AutoFilter Field:=22, Criteria1:="<1", Operator:=xlAnd .Range("$A$15:$a$" & n).SpecialCells(xlCellTypeVisible).EntireRow.Delete .ShowAllData n = .Cells(.Rows.Count, 2).End(xlUp).Row End With For Each wbN In Array("сварка.xlsx", "сборка.xlsx", "механика.xlsx")
Set wb = Workbooks.Open(awb.Path & "\" & wbN)
With wb.Sheets(1) n1 = .Cells(.Rows.Count, 1).SpecialCells(xlLastCell).Row .Rows("15:" & n1).Clear awb.Sheets(1).Range("A15:E" & n).Copy: .Range("A15").PasteSpecial Paste:=xlPasteValues awb.Sheets(1).Range("W15:BN" & n).Copy: .Range("w15").PasteSpecial Paste:=xlPasteValues awb.Sheets(1).Range("a15:BN" & n).Copy: .Range("a15").PasteSpecial Paste:=xlPasteFormats End With Application.CutCopyMode = False wb.Close True Next End Sub
[/vba] Макрос в файле форум. Файл форум - потом закрывайте без сохранения SLAVICK
Доброго времени!!Протестил .почти все хорошо.Можно только, что бы столбцы с F по T вообще бы не копировались в новые книги? ЗЫ. И вопрос вдогонку: а какая разница в разном написании диапазонов? [vba]
Код
Range("W15:BN" & n)..Range("w15")
[/vba]имеется ввиду строчное и прописное W и w [offtop]gпрошу прощения за тавтологию
Доброго времени!!Протестил .почти все хорошо.Можно только, что бы столбцы с F по T вообще бы не копировались в новые книги? ЗЫ. И вопрос вдогонку: а какая разница в разном написании диапазонов? [vba]
Код
Range("W15:BN" & n)..Range("w15")
[/vba]имеется ввиду строчное и прописное W и w [offtop]gпрошу прощения за тавтологию китин
Не судите очень строго:я пытаюсь научиться ЯД 41001877306852
Сообщение отредактировал китин - Пятница, 08.04.2016, 15:34
Sub d() Dim n&, wb As Workbook, awb As Workbook, wbN, n1 Set awb = ThisWorkbook On Error Resume Next With awb.Sheets(1) n = .Cells(.Rows.Count, 2).End(xlUp).Row .ShowAllData .Range("$A$14:$BN$" & n).AutoFilter Field:=22, Criteria1:="<1", _ Operator:=xlAnd .Range("$A$15:$a$" & n).SpecialCells(xlCellTypeVisible).EntireRow.Delete .ShowAllData n = .Cells(.Rows.Count, 2).End(xlUp).Row .Columns("F:T").Delete Shift:=xlToLeft End With For Each wbN In Array("сварка.xlsx", "сборка.xlsx", "механика.xlsx")
Set wb = Workbooks.Open(awb.Path & "\" & wbN)
With wb.Sheets(1) n1 = .Cells(.Rows.Count, 1).SpecialCells(xlLastCell).Row .Rows("15:" & n1).Clear awb.Sheets(1).Range("A15:AZ" & n).Copy .Range("A15").PasteSpecial Paste:=xlPasteValues .Range("a15").PasteSpecial Paste:=xlPasteFormats End With Application.CutCopyMode = False wb.Close True Next End Sub
[/vba]
Так что ли?: [vba]
Код
Sub d() Dim n&, wb As Workbook, awb As Workbook, wbN, n1 Set awb = ThisWorkbook On Error Resume Next With awb.Sheets(1) n = .Cells(.Rows.Count, 2).End(xlUp).Row .ShowAllData .Range("$A$14:$BN$" & n).AutoFilter Field:=22, Criteria1:="<1", _ Operator:=xlAnd .Range("$A$15:$a$" & n).SpecialCells(xlCellTypeVisible).EntireRow.Delete .ShowAllData n = .Cells(.Rows.Count, 2).End(xlUp).Row .Columns("F:T").Delete Shift:=xlToLeft End With For Each wbN In Array("сварка.xlsx", "сборка.xlsx", "механика.xlsx")
Set wb = Workbooks.Open(awb.Path & "\" & wbN)
With wb.Sheets(1) n1 = .Cells(.Rows.Count, 1).SpecialCells(xlLastCell).Row .Rows("15:" & n1).Clear awb.Sheets(1).Range("A15:AZ" & n).Copy .Range("A15").PasteSpecial Paste:=xlPasteValues .Range("a15").PasteSpecial Paste:=xlPasteFormats End With Application.CutCopyMode = False wb.Close True Next End Sub
Слава спасибо.Но столбцы c F по T вообще не нужны. А по факту в копиях они остаются с 1 по 15 строчу, а ниже 15 строки все смещается влево на это кол-во столбцов
Слава спасибо.Но столбцы c F по T вообще не нужны. А по факту в копиях они остаются с 1 по 15 строчу, а ниже 15 строки все смещается влево на это кол-во столбцов китин
Вот попытался тут сваять какую то ерунду по копированию части таблицы в другую книгу. А вот как прописать диапазоны, что бы они искали последнюю заполненную ячейку не получается. [vba]
Код
Sub perenos() Range("A14:E11228,AEU14:AEW11228,AEZ14:AEZ11228,AFC14:AFC11228") _ .Select Selection.Copy Windows("диспетчерская таблица АПРЕЛЬ 2016г. опыт.xlsm").Activate Range("A3").Select ActiveSheet.Paste Windows("ПЛАН АПРЕЛЬ.xlsm").Activate End Sub
[/vba] поытался сделать вот так [vba]
Код
Sub perenos() Dim n&, wb As Workbook, awb As Workbook, wbN, n1 Set awb = ThisWorkbook On Error Resume Next With awb.Sheets(1) n = .Cells(.Rows.Count, 2).End(xlUp).Row Range("$A$14:$E$ & n,$AEU$14:$AEW$ & n,$AEZ$14:$AEZ$ & n,$AFC$14:$AFC$ & n") _ .Select Selection.Copy Windows("диспетчерская таблица АПРЕЛЬ 2016г. опыт.xlsm").Activate Range("A3").Select ActiveSheet.Paste Windows("ПЛАН АПРЕЛЬ.xlsm").Activate End Sub
[/vba] ругается уже на первой строке
Вот попытался тут сваять какую то ерунду по копированию части таблицы в другую книгу. А вот как прописать диапазоны, что бы они искали последнюю заполненную ячейку не получается. [vba]
Код
Sub perenos() Range("A14:E11228,AEU14:AEW11228,AEZ14:AEZ11228,AFC14:AFC11228") _ .Select Selection.Copy Windows("диспетчерская таблица АПРЕЛЬ 2016г. опыт.xlsm").Activate Range("A3").Select ActiveSheet.Paste Windows("ПЛАН АПРЕЛЬ.xlsm").Activate End Sub
[/vba] поытался сделать вот так [vba]
Код
Sub perenos() Dim n&, wb As Workbook, awb As Workbook, wbN, n1 Set awb = ThisWorkbook On Error Resume Next With awb.Sheets(1) n = .Cells(.Rows.Count, 2).End(xlUp).Row Range("$A$14:$E$ & n,$AEU$14:$AEW$ & n,$AEZ$14:$AEZ$ & n,$AFC$14:$AFC$ & n") _ .Select Selection.Copy Windows("диспетчерская таблица АПРЕЛЬ 2016г. опыт.xlsm").Activate Range("A3").Select ActiveSheet.Paste Windows("ПЛАН АПРЕЛЬ.xlsm").Activate End Sub
Sub perenos() Dim n& ' On Error Resume Next With ThisWorkbook.Sheets(1) n = .Cells(.Rows.Count, 2).End(xlUp).Row Intersect(.Range("A:E,AEU:AEW,AEZ:AEZ,AFC:AFC"), .Range("14:" & n)).Copy _ Workbooks("диспетчерская таблица АПРЕЛЬ 2016г. опыт.xlsm").Range("A3") End With End Sub
[/vba]
Попробуй так, файл(ы) не смотрел: [vba]
Код
Sub perenos() Dim n& ' On Error Resume Next With ThisWorkbook.Sheets(1) n = .Cells(.Rows.Count, 2).End(xlUp).Row Intersect(.Range("A:E,AEU:AEW,AEZ:AEZ,AFC:AFC"), .Range("14:" & n)).Copy _ Workbooks("диспетчерская таблица АПРЕЛЬ 2016г. опыт.xlsm").Range("A3") End With End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
