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

Вход

Регистрация

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

 

= Мир MS Excel/Макрос: Добавление пустых строк под и по значению в ячейке - Мир MS Excel

Старая форма входа
  • Страница 1 из 2
  • 1
  • 2
  • »
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос: Добавление пустых строк под и по значению в ячейке (Макросы/Sub)
Макрос: Добавление пустых строк под и по значению в ячейке
Time2burn Дата: Пятница, 05.06.2015, 13:58 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 15
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
Добрый день.
По работе необходимо делать некоторые вводные данные и постоянно нужно добавлять строки равные значению в ячейке. Буду очень признателен, если немного подскажите как мне поменять существующий похожий код, что б работал у меня в нужном русле) (нашел тут на форуме)
[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
Дата добавления - 05.06.2015 в 13:58
Roman777 Дата: Пятница, 05.06.2015, 14:39 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Time2burn, я сам не профи, но мне кажется к данным макросам лучше файл приложить, ибо они привязаны к юзерформам, мне так кажется...)


Много чего не знаю!!!!
 
Ответить
СообщениеTime2burn, я сам не профи, но мне кажется к данным макросам лучше файл приложить, ибо они привязаны к юзерформам, мне так кажется...)

Автор - Roman777
Дата добавления - 05.06.2015 в 14:39
Time2burn Дата: Пятница, 05.06.2015, 15:09 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 15
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
Я думаю не нужно, (так как это будет файл с цифрой 20 и остальное пусто) так как мне вроде проще намного задание нужно:
Добавить строк в количестве равном ячейке в которой курсор, как это сделать я без понятия, т.к. полный 0 в vba. В приведенном примере, пользователь просил при нажатии на макрос копировать строку вниз таблицы, а мне нужно просто добавить пустую в определенных количествах зависимых от значения ячейки.
 
Ответить
СообщениеЯ думаю не нужно, (так как это будет файл с цифрой 20 и остальное пусто) так как мне вроде проще намного задание нужно:
Добавить строк в количестве равном ячейке в которой курсор, как это сделать я без понятия, т.к. полный 0 в vba. В приведенном примере, пользователь просил при нажатии на макрос копировать строку вниз таблицы, а мне нужно просто добавить пустую в определенных количествах зависимых от значения ячейки.

Автор - Time2burn
Дата добавления - 05.06.2015 в 15:09
Roman777 Дата: Пятница, 05.06.2015, 15:22 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Смотри я скинул пример, со своим макросом, я просто пока не оч понял что делает приведённый тобой код. Но вот в моём макросе запусти его и выбири столбец, в котором указаны кол-во добавляемых строк... так надо?
Код сделан деревянно... если кто меня поправит был бы рад (если это вообще то, что имелось в виду).
К сообщению приложен файл: 2467092.xlsm (13.8 Kb)


Много чего не знаю!!!!
 
Ответить
СообщениеСмотри я скинул пример, со своим макросом, я просто пока не оч понял что делает приведённый тобой код. Но вот в моём макросе запусти его и выбири столбец, в котором указаны кол-во добавляемых строк... так надо?
Код сделан деревянно... если кто меня поправит был бы рад (если это вообще то, что имелось в виду).

Автор - Roman777
Дата добавления - 05.06.2015 в 15:22
Roman777 Дата: Пятница, 05.06.2015, 15:28 | Сообщение № 5
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
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
[/vba]

Автор - Roman777
Дата добавления - 05.06.2015 в 15:28
Time2burn Дата: Пятница, 05.06.2015, 15:44 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 15
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
[moder]Не нужно цитировать весь предыдущий пост[/moder]

Именно то, что нужно. Благодарю!
А вот первоначальный пример еще интереснее, я и не думал так запрашивать, а с ходу вы предложили еще лучше вариант))) но почему-то не работает в других книгах. Наверное перенес не правильно, сейчас опробую вновь.

[i]На радостях не заметил - а как сделать что б добавляло на 1 строку меньше от значения в ячейке - первая с которой вставляю строки рабочая)


Сообщение отредактировал Time2burn - Пятница, 05.06.2015, 15:49
 
Ответить
Сообщение[moder]Не нужно цитировать весь предыдущий пост[/moder]

Именно то, что нужно. Благодарю!
А вот первоначальный пример еще интереснее, я и не думал так запрашивать, а с ходу вы предложили еще лучше вариант))) но почему-то не работает в других книгах. Наверное перенес не правильно, сейчас опробую вновь.

[i]На радостях не заметил - а как сделать что б добавляло на 1 строку меньше от значения в ячейке - первая с которой вставляю строки рабочая)

Автор - Time2burn
Дата добавления - 05.06.2015 в 15:44
Roman777 Дата: Пятница, 05.06.2015, 16:05 | Сообщение № 7
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
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]


Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Пятница, 05.06.2015, 16:07
 
Ответить
Сообщение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]

Автор - Roman777
Дата добавления - 05.06.2015 в 16:05
Roman777 Дата: Пятница, 05.06.2015, 16:10 | Сообщение № 8
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Time2burn, Единственное, сразу замечу, что в этом случае, если в ячейке будет значение 1, то Макрос даст ошибку.


Много чего не знаю!!!!
 
Ответить
СообщениеTime2burn, Единственное, сразу замечу, что в этом случае, если в ячейке будет значение 1, то Макрос даст ошибку.

Автор - Roman777
Дата добавления - 05.06.2015 в 16:10
Time2burn Дата: Пятница, 05.06.2015, 16:15 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 15
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
Да, ок. Тем более все числа идут свыше 1.
 
Ответить
СообщениеДа, ок. Тем более все числа идут свыше 1.

Автор - Time2burn
Дата добавления - 05.06.2015 в 16:15
KSV Дата: Пятница, 05.06.2015, 16:33 | Сообщение № 10
Группа: Друзья
Ранг: Ветеран
Сообщений: 770
Репутация: 255 ±
Замечаний: 0% ±

Excel 2013
или можно так (одним разом, без циклов):
[vba]
Код
Sub AddRows()
     If Val(ActiveCell) > 1 Then ActiveCell.Offset(1).Resize(ActiveCell - 1).EntireRow.Insert
End Sub
[/vba]


KSV.VBA@gmail.com
Яндекс.Деньги: 410011921213333
 
Ответить
Сообщениеили можно так (одним разом, без циклов):
[vba]
Код
Sub AddRows()
     If Val(ActiveCell) > 1 Then ActiveCell.Offset(1).Resize(ActiveCell - 1).EntireRow.Insert
End Sub
[/vba]

Автор - KSV
Дата добавления - 05.06.2015 в 16:33
Roman777 Дата: Пятница, 05.06.2015, 16:35 | Сообщение № 11
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
KSV, О! прикольно, не знал как мон сразу "N" строк вставлять))).


Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Пятница, 05.06.2015, 16:41
 
Ответить
СообщениеKSV, О! прикольно, не знал как мон сразу "N" строк вставлять))).

Автор - Roman777
Дата добавления - 05.06.2015 в 16:35
Time2burn Дата: Пятница, 05.06.2015, 16:36 | Сообщение № 12
Группа: Пользователи
Ранг: Новичок
Сообщений: 15
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
KSV, В вашем случае добавляет на 2 строки меньше чем значение в ячейке :)

Попробовал дальше - как-то на разные числа меньше строк добавляет ваш макрос... :С


P.S. Стояла фильтрация, теперь все нормально :)


Сообщение отредактировал Time2burn - Пятница, 05.06.2015, 16:43
 
Ответить
СообщениеKSV, В вашем случае добавляет на 2 строки меньше чем значение в ячейке :)

Попробовал дальше - как-то на разные числа меньше строк добавляет ваш макрос... :С


P.S. Стояла фильтрация, теперь все нормально :)

Автор - Time2burn
Дата добавления - 05.06.2015 в 16:36
Roman777 Дата: Пятница, 05.06.2015, 16:42 | Сообщение № 13
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
KSV,
Не пойму, к чему тут Resize относится... если Ваш макрос написать так:
[vba]
Код
Sub AddRows()
     If Val(ActiveCell) > 1 Then ActiveCell.Offset(1).EntireRow.Resize(ActiveCell - 1).Insert
End Sub
[/vba]
тоже работает...XD


Много чего не знаю!!!!
 
Ответить
СообщениеKSV,
Не пойму, к чему тут Resize относится... если Ваш макрос написать так:
[vba]
Код
Sub AddRows()
     If Val(ActiveCell) > 1 Then ActiveCell.Offset(1).EntireRow.Resize(ActiveCell - 1).Insert
End Sub
[/vba]
тоже работает...XD

Автор - Roman777
Дата добавления - 05.06.2015 в 16:42
Roman777 Дата: Пятница, 05.06.2015, 16:43 | Сообщение № 14
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Time2burn, У меня работает норм, да и не должен он на 2 строки меньше заданного числа вставлять...
А... всё выяснилось)


Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Пятница, 05.06.2015, 16:44
 
Ответить
СообщениеTime2burn, У меня работает норм, да и не должен он на 2 строки меньше заданного числа вставлять...
А... всё выяснилось)

Автор - Roman777
Дата добавления - 05.06.2015 в 16:43
Time2burn Дата: Пятница, 05.06.2015, 16:47 | Сообщение № 15
Группа: Пользователи
Ранг: Новичок
Сообщений: 15
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
Всем спасибо за помощь ) плюсанул Вам обоим!
 
Ответить
СообщениеВсем спасибо за помощь ) плюсанул Вам обоим!

Автор - Time2burn
Дата добавления - 05.06.2015 в 16:47
KSV Дата: Пятница, 05.06.2015, 16:50 | Сообщение № 16
Группа: Друзья
Ранг: Ветеран
Сообщений: 770
Репутация: 255 ±
Замечаний: 0% ±

Excel 2013
см. вложенный файл
К сообщению приложен файл: 618.xlsm (14.2 Kb)


KSV.VBA@gmail.com
Яндекс.Деньги: 410011921213333
 
Ответить
Сообщениесм. вложенный файл

Автор - KSV
Дата добавления - 05.06.2015 в 16:50
Time2burn Дата: Пятница, 05.06.2015, 17:18 | Сообщение № 17
Группа: Пользователи
Ранг: Новичок
Сообщений: 15
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
Спасибо, эт я умею) А с столбцом так можно сделать как в сообщении №4 (там на 1 меньше нужно добавлять ячейку от значения)? ) ^_^
 
Ответить
СообщениеСпасибо, эт я умею) А с столбцом так можно сделать как в сообщении №4 (там на 1 меньше нужно добавлять ячейку от значения)? ) ^_^

Автор - Time2burn
Дата добавления - 05.06.2015 в 17:18
KSV Дата: Пятница, 05.06.2015, 17:51 | Сообщение № 18
Группа: Друзья
Ранг: Ветеран
Сообщений: 770
Репутация: 255 ±
Замечаний: 0% ±

Excel 2013
так?

(см. вложенный файл)
К сообщению приложен файл: 2467092-1-.xlsm (15.3 Kb)


KSV.VBA@gmail.com
Яндекс.Деньги: 410011921213333


Сообщение отредактировал KSV - Пятница, 05.06.2015, 17:53
 
Ответить
Сообщениетак?

(см. вложенный файл)

Автор - KSV
Дата добавления - 05.06.2015 в 17:51
Time2burn Дата: Пятница, 05.06.2015, 18:05 | Сообщение № 19
Группа: Пользователи
Ранг: Новичок
Сообщений: 15
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
Да ! Вот это спасибище!
 
Ответить
СообщениеДа ! Вот это спасибище!

Автор - Time2burn
Дата добавления - 05.06.2015 в 18:05
Time2burn Дата: Понедельник, 08.06.2015, 09:45 | Сообщение № 20
Группа: Пользователи
Ранг: Новичок
Сообщений: 15
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
хм, при выборе столбца - почему-то добавляет ячейки по значению с другого столбца))
 
Ответить
Сообщениехм, при выборе столбца - почему-то добавляет ячейки по значению с другого столбца))

Автор - Time2burn
Дата добавления - 08.06.2015 в 09:45
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос: Добавление пустых строк под и по значению в ячейке (Макросы/Sub)
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

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