Vselennaya, у вас в каждом выложенном файле все время разные данные: то Итого по хозяйственному Итого по обычному, а в последнем файле уже ИТОГО по ло-ву Вы не могли бы прийти к единой терминологии. Дальше, если у вас номера могут быть с начальным нулем, например 0738А, то вы говорили, что в имени листа этого нуля не будет, но я вижу, что есть лист 0738. (Я полагал, что будет 738) На листах с именем номера вагона шапка B14:N14 уже существует? Почему-то на некоторых листах ее нет. И, главное, не могли бы вы отвечать быстрее на мои вопросы.
Vselennaya, у вас в каждом выложенном файле все время разные данные: то Итого по хозяйственному Итого по обычному, а в последнем файле уже ИТОГО по ло-ву Вы не могли бы прийти к единой терминологии. Дальше, если у вас номера могут быть с начальным нулем, например 0738А, то вы говорили, что в имени листа этого нуля не будет, но я вижу, что есть лист 0738. (Я полагал, что будет 738) На листах с именем номера вагона шапка B14:N14 уже существует? Почему-то на некоторых листах ее нет. И, главное, не могли бы вы отвечать быстрее на мои вопросы.Kuzmich
Kuzmich, нет там шапки, где не проставляет данные. Естественно, я и шапки расставлю. Там сотни номеров будет и вкладок в итоге. С нулями это назвала листы, чтобы посмотреть расставит макрос данные или нет. Увы не расставил. По поводу формулировки Итого, простите не знала, что имеет значение. ИТОГО по ло-ву должно быть. Как в последнем. Стараюсь отвечать как можно быстрее. Очень отвлекают другими рабочими вопросами. Извините
Kuzmich, нет там шапки, где не проставляет данные. Естественно, я и шапки расставлю. Там сотни номеров будет и вкладок в итоге. С нулями это назвала листы, чтобы посмотреть расставит макрос данные или нет. Увы не расставил. По поводу формулировки Итого, простите не знала, что имеет значение. ИТОГО по ло-ву должно быть. Как в последнем. Стараюсь отвечать как можно быстрее. Очень отвлекают другими рабочими вопросами. ИзвинитеVselennaya
На листах с именем номера вагона шапка B14:N14 должна быть всегда, макрос ориентируется на эту строку Для вашего последнего примера
[vba]
Код
Sub iNomer() Dim iNumber As String Dim i As Long Dim iLastRow As Long Dim iLR As Long Dim FoundCell As Range Dim FAdr As String Dim FAdr_Row As Long Dim EAdr_Row As Long Dim n As Integer With CreateObject("scripting.dictionary"): .comparemode = 1 n = 15 iLastRow = Cells(Rows.Count, "C").End(xlUp).Row Range("S15:S" & Cells(Rows.Count, "S").End(xlUp).Row).ClearContents For i = 15 To iLastRow 'выделяем из столбца C уникальные номера If Cells(i, "C") <> "" Then With CreateObject("VBScript.RegExp") .Global = True .Pattern = "\d+" iNumber = .Execute(Cells(i, "C"))(0) End With 'If Not .exists(Left(Cells(i, "C").Value, 3)) Then If Not .exists(iNumber) Then 'если нет слова, то добавляем его в словарь и в столбец S .Add iNumber, 1 Cells(n, "S").NumberFormat = "@" 'текстовый формат ячейки Cells(n, "S") = iNumber n = n + 1 End If End If Next End With iLastRow = Cells(Rows.Count, "S").End(xlUp).Row For i = 15 To iLastRow 'цикл по уникальным номерам в S Set FoundCell = Columns(3).Find(Cells(i, "S"), , xlValues, xlPart) If Not FoundCell Is Nothing Then FAdr = FoundCell.Address FAdr_Row = FoundCell.Row 'первая строка с уникальным номером Do EAdr_Row = FoundCell.Row 'последняя строка с уникальным номером Set FoundCell = Columns(3).FindNext(FoundCell) Loop While FoundCell.Address <> FAdr End If With Worksheets(CStr(Cells(i, "S"))) 'очищаем диапазон на соответствующем листе .Range("B15:N" & .Cells(.Rows.Count, "B").End(xlUp).Row + 1).Clear 'копируем диапазон от первой до последней строки + 1 уникального номера 'чтобы захватить строку с ИТОГО по ко-ву Range("B" & FAdr_Row & ":N" & EAdr_Row + 1).Copy .Range("B15") iLR = .Cells(.Rows.Count, "B").End(xlUp).Row .Range("B" & iLR + 2) = "Всего" .Range("D" & iLR + 2) = Application.Sum(.Range("D15:D" & iLR)) .Range("E" & iLR + 2) = Application.Sum(.Range("E15:E" & iLR)) .Range("F" & iLR + 2) = Application.Sum(.Range("F15:F" & iLR)) .Range("N" & iLR + 2) = Application.Sum(.Range("N15:N" & iLR))
.Range("B" & iLR + 4) = "Период формирования акта от: " & Cells(FAdr_Row, "G") & _ " до " & Cells(EAdr_Row, "G") For n = iLR To 15 Step -1 'удаляем строки на соответствующем листе с ИТОГО If .Cells(n, "B") Like "ИТОГО*" Then .Rows(n).Delete End If Next End With Next End Sub
[/vba]
Привел пример формирования строки под таблицей "Период формирования акта от: " Используйте этот принцип для своей шапки под таблицей
На листах с именем номера вагона шапка B14:N14 должна быть всегда, макрос ориентируется на эту строку Для вашего последнего примера
[vba]
Код
Sub iNomer() Dim iNumber As String Dim i As Long Dim iLastRow As Long Dim iLR As Long Dim FoundCell As Range Dim FAdr As String Dim FAdr_Row As Long Dim EAdr_Row As Long Dim n As Integer With CreateObject("scripting.dictionary"): .comparemode = 1 n = 15 iLastRow = Cells(Rows.Count, "C").End(xlUp).Row Range("S15:S" & Cells(Rows.Count, "S").End(xlUp).Row).ClearContents For i = 15 To iLastRow 'выделяем из столбца C уникальные номера If Cells(i, "C") <> "" Then With CreateObject("VBScript.RegExp") .Global = True .Pattern = "\d+" iNumber = .Execute(Cells(i, "C"))(0) End With 'If Not .exists(Left(Cells(i, "C").Value, 3)) Then If Not .exists(iNumber) Then 'если нет слова, то добавляем его в словарь и в столбец S .Add iNumber, 1 Cells(n, "S").NumberFormat = "@" 'текстовый формат ячейки Cells(n, "S") = iNumber n = n + 1 End If End If Next End With iLastRow = Cells(Rows.Count, "S").End(xlUp).Row For i = 15 To iLastRow 'цикл по уникальным номерам в S Set FoundCell = Columns(3).Find(Cells(i, "S"), , xlValues, xlPart) If Not FoundCell Is Nothing Then FAdr = FoundCell.Address FAdr_Row = FoundCell.Row 'первая строка с уникальным номером Do EAdr_Row = FoundCell.Row 'последняя строка с уникальным номером Set FoundCell = Columns(3).FindNext(FoundCell) Loop While FoundCell.Address <> FAdr End If With Worksheets(CStr(Cells(i, "S"))) 'очищаем диапазон на соответствующем листе .Range("B15:N" & .Cells(.Rows.Count, "B").End(xlUp).Row + 1).Clear 'копируем диапазон от первой до последней строки + 1 уникального номера 'чтобы захватить строку с ИТОГО по ко-ву Range("B" & FAdr_Row & ":N" & EAdr_Row + 1).Copy .Range("B15") iLR = .Cells(.Rows.Count, "B").End(xlUp).Row .Range("B" & iLR + 2) = "Всего" .Range("D" & iLR + 2) = Application.Sum(.Range("D15:D" & iLR)) .Range("E" & iLR + 2) = Application.Sum(.Range("E15:E" & iLR)) .Range("F" & iLR + 2) = Application.Sum(.Range("F15:F" & iLR)) .Range("N" & iLR + 2) = Application.Sum(.Range("N15:N" & iLR))
.Range("B" & iLR + 4) = "Период формирования акта от: " & Cells(FAdr_Row, "G") & _ " до " & Cells(EAdr_Row, "G") For n = iLR To 15 Step -1 'удаляем строки на соответствующем листе с ИТОГО If .Cells(n, "B") Like "ИТОГО*" Then .Rows(n).Delete End If Next End With Next End Sub
[/vba]
Привел пример формирования строки под таблицей "Период формирования акта от: " Используйте этот принцип для своей шапки под таблицейKuzmich
Сообщение отредактировал Kuzmich - Вторник, 19.06.2018, 16:25
Kuzmich, СПАСИБО огромное. Последние я надеюсь вопросы. А как сделать заливку строки ВСЕГО на каждом листе и продлить таблицу до этой строки?! И как заполнить нижнюю шапку именно текст я поняла. А можно просто чтоб в каждом листе она была вставлена так же как верхняя шапка таблицы и просто смещалась соответственно формированию таблицы вниз? В примере цветными вкладками выделила как должно быть и откуда данные берутся. Вот данные я буду сама вставлять и они будут в шапочку верхнюю и нижнюю переноситься. И просто надо чтою смещалась вниз шапка нижняя. Единственное одна цифра будет в саму таблицу проставляться из данных для шапки . Как сделать так, чтобы они проставлялись в таблицу макросом сформированную?
Kuzmich, СПАСИБО огромное. Последние я надеюсь вопросы. А как сделать заливку строки ВСЕГО на каждом листе и продлить таблицу до этой строки?! И как заполнить нижнюю шапку именно текст я поняла. А можно просто чтоб в каждом листе она была вставлена так же как верхняя шапка таблицы и просто смещалась соответственно формированию таблицы вниз? В примере цветными вкладками выделила как должно быть и откуда данные берутся. Вот данные я буду сама вставлять и они будут в шапочку верхнюю и нижнюю переноситься. И просто надо чтою смещалась вниз шапка нижняя. Единственное одна цифра будет в саму таблицу проставляться из данных для шапки . Как сделать так, чтобы они проставлялись в таблицу макросом сформированную? Vselennaya
[/vba] По вопросу формирования нижней шапки надо еще подумать, но может ее поместить на лист 'данные для шапки' и потом копировать на соответствующий лист после таблицы. Пришлите свой адрес электронной почты, а то у меня размер файла уже превышает 500 Кб
Цитата
как сделать заливку строки ВСЕГО на каждом листе и продлить таблицу до этой строки?!
[/vba] По вопросу формирования нижней шапки надо еще подумать, но может ее поместить на лист 'данные для шапки' и потом копировать на соответствующий лист после таблицы. Пришлите свой адрес электронной почты, а то у меня размер файла уже превышает 500 КбKuzmich