Добрый день. По работе необходимо делать некоторые вводные данные и постоянно нужно добавлять строки равные значению в ячейке. Буду очень признателен, если немного подскажите как мне поменять существующий похожий код, что б работал у меня в нужном русле) (нашел тут на форуме) [vba]
Код
Private Sub ComboBox1_Change() ComboBox1.ListFillRange = "=DDL_Range" Me.ComboBox1.DropDown End Sub
Private Sub CommandButton1_Click() lr = Cells(Rows.Count, 1).End(xlUp).Row vvv = ComboBox1.Value Set sh = Sheets("Áàçà äàííûõ") lr2 = sh.Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To lr2 If sh.Cells(i, 1) = vvv Then vRow = i: Exit For Next If IsEmpty(vRow) Then Exit Sub Range("A" & lr + 1, "E" & lr + 1).Value = sh.Range("A" & vRow, "E" & vRow).Value End Sub
Sub test() lr = Cells(Rows.Count, 1).End(xlUp).Row Range("A" & lr + 1, "E" & lr + 1).Value = Range("A8", "E8").Value End Sub
[/vba]
У меня в ячейке значение к примеру 20 - тоесть нужно добавить 20-1 = 19 строк под этой ячейкой. Макрос буду использовать не в одном файле, а в многих. Спасибо за ответы!
Добрый день. По работе необходимо делать некоторые вводные данные и постоянно нужно добавлять строки равные значению в ячейке. Буду очень признателен, если немного подскажите как мне поменять существующий похожий код, что б работал у меня в нужном русле) (нашел тут на форуме) [vba]
Код
Private Sub ComboBox1_Change() ComboBox1.ListFillRange = "=DDL_Range" Me.ComboBox1.DropDown End Sub
Private Sub CommandButton1_Click() lr = Cells(Rows.Count, 1).End(xlUp).Row vvv = ComboBox1.Value Set sh = Sheets("Áàçà äàííûõ") lr2 = sh.Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To lr2 If sh.Cells(i, 1) = vvv Then vRow = i: Exit For Next If IsEmpty(vRow) Then Exit Sub Range("A" & lr + 1, "E" & lr + 1).Value = sh.Range("A" & vRow, "E" & vRow).Value End Sub
Sub test() lr = Cells(Rows.Count, 1).End(xlUp).Row Range("A" & lr + 1, "E" & lr + 1).Value = Range("A8", "E8").Value End Sub
[/vba]
У меня в ячейке значение к примеру 20 - тоесть нужно добавить 20-1 = 19 строк под этой ячейкой. Макрос буду использовать не в одном файле, а в многих. Спасибо за ответы!Time2burn
Я думаю не нужно, (так как это будет файл с цифрой 20 и остальное пусто) так как мне вроде проще намного задание нужно: Добавить строк в количестве равном ячейке в которой курсор, как это сделать я без понятия, т.к. полный 0 в vba. В приведенном примере, пользователь просил при нажатии на макрос копировать строку вниз таблицы, а мне нужно просто добавить пустую в определенных количествах зависимых от значения ячейки.
Я думаю не нужно, (так как это будет файл с цифрой 20 и остальное пусто) так как мне вроде проще намного задание нужно: Добавить строк в количестве равном ячейке в которой курсор, как это сделать я без понятия, т.к. полный 0 в vba. В приведенном примере, пользователь просил при нажатии на макрос копировать строку вниз таблицы, а мне нужно просто добавить пустую в определенных количествах зависимых от значения ячейки.Time2burn
Смотри я скинул пример, со своим макросом, я просто пока не оч понял что делает приведённый тобой код. Но вот в моём макросе запусти его и выбири столбец, в котором указаны кол-во добавляемых строк... так надо? Код сделан деревянно... если кто меня поправит был бы рад (если это вообще то, что имелось в виду).
Смотри я скинул пример, со своим макросом, я просто пока не оч понял что делает приведённый тобой код. Но вот в моём макросе запусти его и выбири столбец, в котором указаны кол-во добавляемых строк... так надо? Код сделан деревянно... если кто меня поправит был бы рад (если это вообще то, что имелось в виду).Roman777
Time2burn, Простите, не увидел, что хотите по выделению ячейки. Можно так: [vba]
Код
Sub ДобавитьСтрокиПоВыделениюЯчейки() Dim n As Long Dim RowW As Long Dim ColumnW As Long Dim j As Long RowW = Selection.Row ColumnW = Selection.Column If Cells(RowW, ColumnW) <> "" Then For j = 1 To Cells(RowW + n, ColumnW) Rows(RowW + n + 1).Insert n = n + 1 Next j End If End Sub
[/vba]
Time2burn, Простите, не увидел, что хотите по выделению ячейки. Можно так: [vba]
Код
Sub ДобавитьСтрокиПоВыделениюЯчейки() Dim n As Long Dim RowW As Long Dim ColumnW As Long Dim j As Long RowW = Selection.Row ColumnW = Selection.Column If Cells(RowW, ColumnW) <> "" Then For j = 1 To Cells(RowW + n, ColumnW) Rows(RowW + n + 1).Insert n = n + 1 Next j End If End Sub
[moder]Не нужно цитировать весь предыдущий пост[/moder]
Именно то, что нужно. Благодарю! А вот первоначальный пример еще интереснее, я и не думал так запрашивать, а с ходу вы предложили еще лучше вариант))) но почему-то не работает в других книгах. Наверное перенес не правильно, сейчас опробую вновь.
[i]На радостях не заметил - а как сделать что б добавляло на 1 строку меньше от значения в ячейке - первая с которой вставляю строки рабочая)
[moder]Не нужно цитировать весь предыдущий пост[/moder]
Именно то, что нужно. Благодарю! А вот первоначальный пример еще интереснее, я и не думал так запрашивать, а с ходу вы предложили еще лучше вариант))) но почему-то не работает в других книгах. Наверное перенес не правильно, сейчас опробую вновь.
[i]На радостях не заметил - а как сделать что б добавляло на 1 строку меньше от значения в ячейке - первая с которой вставляю строки рабочая)Time2burn
Сообщение отредактировал Time2burn - Пятница, 05.06.2015, 15:49
Time2burn, На самом деле, макрос оч плохо написан и расчитан на то, что у вас в ячейках либо пусто либо цифра. В других книгах чтобы работало, можно макрос сохранить в личную книгу макросов и запускать из той книги, в которой необходимо редактировать. И макрос требует выделения соответствующей ячейки. Чтобы добавлялось на 1 меньше, надо подправить общее число повторений в цикле. Макрос будет такой: [vba]
Код
Sub ДобавитьСтрокиПоВыделениюЯчейки() Dim n As Long Dim RowW As Long Dim ColumnW As Long Dim j As Long RowW = Selection.Row ColumnW = Selection.Column If Cells(RowW, ColumnW) <> "" Then For j = 1 To Cells(RowW + n, ColumnW) - 1 Rows(RowW + n + 1).Insert n = n + 1 Next j End If End Sub
[/vba]
Time2burn, На самом деле, макрос оч плохо написан и расчитан на то, что у вас в ячейках либо пусто либо цифра. В других книгах чтобы работало, можно макрос сохранить в личную книгу макросов и запускать из той книги, в которой необходимо редактировать. И макрос требует выделения соответствующей ячейки. Чтобы добавлялось на 1 меньше, надо подправить общее число повторений в цикле. Макрос будет такой: [vba]
Код
Sub ДобавитьСтрокиПоВыделениюЯчейки() Dim n As Long Dim RowW As Long Dim ColumnW As Long Dim j As Long RowW = Selection.Row ColumnW = Selection.Column If Cells(RowW, ColumnW) <> "" Then For j = 1 To Cells(RowW + n, ColumnW) - 1 Rows(RowW + n + 1).Insert n = n + 1 Next j End If End Sub
On Error Resume Next Set Stolbec = Application.InputBox("Укажите столбец со значениями (указывающими на кол-во добавляемых строк)", "Столбец", Type:=8) If Err.Number Then Exit Sub ' нажали кнопку "Отмена"
For Each Stolbec In Stolbec.CurrentRegion If Val(Stolbec) > 1 Then Stolbec.Offset(1).Resize(Stolbec - 1).EntireRow.Insert Next End Sub
[/vba]
(см. вложенный файл)
так?
[vba]
Код
Sub AddRows() Dim Stolbec As Range
On Error Resume Next Set Stolbec = Application.InputBox("Укажите столбец со значениями (указывающими на кол-во добавляемых строк)", "Столбец", Type:=8) If Err.Number Then Exit Sub ' нажали кнопку "Отмена"
For Each Stolbec In Stolbec.CurrentRegion If Val(Stolbec) > 1 Then Stolbec.Offset(1).Resize(Stolbec - 1).EntireRow.Insert Next End Sub