Всем Привет. Появилась проблемка, вроде бы в простом деле. Нужно по условию (168) найти все строки на странице Список1, скопировать на страницу Шаблон и лишние строки удалить. Делаю так - не работает [vba]
Код
Sub DrukNariad() Dim x&, arr(), number$, rr As Range 'Dim i As Long, nRow As Long x = "168" Sheets("Список1").Select nRow = ActiveSheet.Columns(1).End(xlDown).Row For i = 2 To nRow Set rr = Columns(1).Cells.Find(What:=x) If Not rr Is Nothing Then Sheets("Шаблон").Select 'ActiveCell.Offset(0, 2).Select rr.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 3).Value = Sheets("Список").Cells(i, 1).Resize(, 3).Value End If Set rr = Nothing Next i End Sub
[/vba]
Всем Привет. Появилась проблемка, вроде бы в простом деле. Нужно по условию (168) найти все строки на странице Список1, скопировать на страницу Шаблон и лишние строки удалить. Делаю так - не работает [vba]
Код
Sub DrukNariad() Dim x&, arr(), number$, rr As Range 'Dim i As Long, nRow As Long x = "168" Sheets("Список1").Select nRow = ActiveSheet.Columns(1).End(xlDown).Row For i = 2 To nRow Set rr = Columns(1).Cells.Find(What:=x) If Not rr Is Nothing Then Sheets("Шаблон").Select 'ActiveCell.Offset(0, 2).Select rr.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 3).Value = Sheets("Список").Cells(i, 1).Resize(, 3).Value End If Set rr = Nothing Next i End Sub
лишние строки удалить на листе шаблон? или список? [vba]
Код
Sub DrukNariad() Dim x&, arr(), number$, rr As Range 'Dim i As Long, nRow As Long x = "168" Set sh1 = Sheets("Список1") Set sh2 = Sheets("Шаблон") nRow = ActiveSheet.Columns(1).End(xlDown).Row For i = 2 To nRow If sh1.Cells(i, 1) = x Then sh2.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 3).Value = sh1.Cells(i, 1).Resize(, 3).Value End If Next i End Sub
[/vba]
лишние строки удалить на листе шаблон? или список? [vba]
Код
Sub DrukNariad() Dim x&, arr(), number$, rr As Range 'Dim i As Long, nRow As Long x = "168" Set sh1 = Sheets("Список1") Set sh2 = Sheets("Шаблон") nRow = ActiveSheet.Columns(1).End(xlDown).Row For i = 2 To nRow If sh1.Cells(i, 1) = x Then sh2.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 3).Value = sh1.Cells(i, 1).Resize(, 3).Value End If Next i End Sub
А зачем удалять лишние на шаблоне? Не проще не создавать там ненужных строк? Не очень понимаю.
Попробую обяснить. Строк (под номером 168) может быть от 1 до 40. Так как ниже таблицы идут лругие данные то можно пойти двумя путями: 1. Вставлять строки сколько нужно под номером 168 ( данном случае 3) 2. Делаем в шаблоне 50 строк, заполняем сколько нужно и лишние удаляем. Думаю 2 способ легче.
А зачем удалять лишние на шаблоне? Не проще не создавать там ненужных строк? Не очень понимаю.
Попробую обяснить. Строк (под номером 168) может быть от 1 до 40. Так как ниже таблицы идут лругие данные то можно пойти двумя путями: 1. Вставлять строки сколько нужно под номером 168 ( данном случае 3) 2. Делаем в шаблоне 50 строк, заполняем сколько нужно и лишние удаляем. Думаю 2 способ легче.SergioGach
Работает. Спасибо. Но я не предусмотрел что выше таблицы тоже есть строки, а так уже не работает. Возможно ли превязать вставку к ячейке В3 или первая куда вставить В4 (они неизменные) См. файл
Работает. Спасибо. Но я не предусмотрел что выше таблицы тоже есть строки, а так уже не работает. Возможно ли превязать вставку к ячейке В3 или первая куда вставить В4 (они неизменные) См. файлSergioGach
SergioGach, а можно убрать объединенные ячейки? если можно, то вот мой вариант, проверяйте создал две умные таблицы Список1 и Шаблон в модуле листа Список1 код [vba]
Код
Private Sub copy_rows(num) Dim b As Boolean Dim Список1 As ListObject: Set Список1 = Me.ListObjects("Список1") Dim Шаблон As ListObject: Set Шаблон = Parent.Sheets("Шаблон").ListObjects("Шаблон") rr: If num & "" <> num Or num = "" Then If MsgBox("номер не введений, повторити введення?", 36) = 6 Then num = Application.InputBox("Введіть номер"): GoTo rr Else: Exit Sub End If ElseIf Список1.ListColumns(1).Range.Find(num, , , 1) Is Nothing Then If MsgBox("номер не знайдений, повторити введення?", 36) = 6 Then num = Application.InputBox("Введіть номер"): GoTo rr Else: Exit Sub End If End If Application.ScreenUpdating = 0: Application.EnableEvents = 0 If Not Шаблон.DataBodyRange Is Nothing Then Шаблон.DataBodyRange.Delete Список1.Range.AutoFilter Field:=1, Criteria1:=num Список1.DataBodyRange.Offset(, 1).Resize(, 3).SpecialCells(12).Copy Шаблон.HeaderRowRange(2, 2).PasteSpecial xlPasteValues Список1.Range.AutoFilter Шаблон.Parent.Activate: Шаблон.HeaderRowRange(1).Activate Set Список1 = Nothing: Set Шаблон = Nothing Application.ScreenUpdating = 1: Application.EnableEvents = 1 End Sub Private Sub test() copy_rows Application.InputBox("Введіть номер") End Sub
[/vba] жмете кнопку, пишете номер или выбираете ячейку с номерм, жмете ОК или Enter
SergioGach, а можно убрать объединенные ячейки? если можно, то вот мой вариант, проверяйте создал две умные таблицы Список1 и Шаблон в модуле листа Список1 код [vba]
Код
Private Sub copy_rows(num) Dim b As Boolean Dim Список1 As ListObject: Set Список1 = Me.ListObjects("Список1") Dim Шаблон As ListObject: Set Шаблон = Parent.Sheets("Шаблон").ListObjects("Шаблон") rr: If num & "" <> num Or num = "" Then If MsgBox("номер не введений, повторити введення?", 36) = 6 Then num = Application.InputBox("Введіть номер"): GoTo rr Else: Exit Sub End If ElseIf Список1.ListColumns(1).Range.Find(num, , , 1) Is Nothing Then If MsgBox("номер не знайдений, повторити введення?", 36) = 6 Then num = Application.InputBox("Введіть номер"): GoTo rr Else: Exit Sub End If End If Application.ScreenUpdating = 0: Application.EnableEvents = 0 If Not Шаблон.DataBodyRange Is Nothing Then Шаблон.DataBodyRange.Delete Список1.Range.AutoFilter Field:=1, Criteria1:=num Список1.DataBodyRange.Offset(, 1).Resize(, 3).SpecialCells(12).Copy Шаблон.HeaderRowRange(2, 2).PasteSpecial xlPasteValues Список1.Range.AutoFilter Шаблон.Parent.Activate: Шаблон.HeaderRowRange(1).Activate Set Список1 = Nothing: Set Шаблон = Nothing Application.ScreenUpdating = 1: Application.EnableEvents = 1 End Sub Private Sub test() copy_rows Application.InputBox("Введіть номер") End Sub
[/vba] жмете кнопку, пишете номер или выбираете ячейку с номерм, жмете ОК или Enterkrosav4ig
SergioGach, а можно убрать объединенные ячейки? если можно, то вот мой вариант, проверяйте создал две умные таблицы Список1 и Шаблон в модуле листа Список1 код
Так, как шаблон не мой и утвержденный объединение ячеек не убрать. К тому же с помощью Leanna данный вопрос решен. Но Вам СПАСИБО! Я изучу Ваш пример. Сейчас у меня другая проблема при переносе столбца количество нужно что б в шаблон вставлялося число прописью. например "Список1" в колонке "К-ство" 150,5 переносит "Шаблон" в колонку "К-ство" = Сто пятьдесят целых пять десятых. Для АДМИНА - это не новый вопрос, а просто информация. Сначала сам буду пробовать и если нужда заставит то создам новую тему.
SergioGach, а можно убрать объединенные ячейки? если можно, то вот мой вариант, проверяйте создал две умные таблицы Список1 и Шаблон в модуле листа Список1 код
Так, как шаблон не мой и утвержденный объединение ячеек не убрать. К тому же с помощью Leanna данный вопрос решен. Но Вам СПАСИБО! Я изучу Ваш пример. Сейчас у меня другая проблема при переносе столбца количество нужно что б в шаблон вставлялося число прописью. например "Список1" в колонке "К-ство" 150,5 переносит "Шаблон" в колонку "К-ство" = Сто пятьдесят целых пять десятых. Для АДМИНА - это не новый вопрос, а просто информация. Сначала сам буду пробовать и если нужда заставит то создам новую тему.SergioGach