Вопрос по макросу на создание пустых строчек и их заполнение

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Вопрос по макросу на создание пустых строчек и их заполнение (Помогите сделать макрос)

БодрыйБабуин

Дата: Четверг, 21.03.2013, 18:30 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

Репутация: 0 ±

Замечаний: 0% ±

Заранее прошу прощения у администрации и участников форума если нарушил этой темой какое либо правило. Я не специально smile

Вопрос следующего характера:
Для того чтобы обработать большой массив данных нужен макрос, который берет первую строку, смотрит на определенную ячейку, скажем b1. Если в ячейке больше 0, 7, 14, 21 или 28 знаков, то макрос должен создать соответственно 1, 2, 3, 4 или 5 пустых строчек под данной строкой. В пустые строки необходимо скопировать содержимое первой строки. Далее берется вторая строка, с которой проделывается та же операция. И так до конца списка.

В макросах практически ничего не понимаю. Если поможете буду очень благодарен. Заранее спасибо smile

К сообщению приложен файл: 5316860.xlsx (9.7 Kb)

Сообщение отредактировал БодрыйБабуин - Четверг, 21.03.2013, 18:51

Ответить

AlexM

Дата: Четверг, 21.03.2013, 18:45 | Сообщение № 2

Группа: Друзья

Ранг: Участник клуба

Сообщений: 4513

Репутация: 1128 ±

Замечаний: 0% ±

Excel 2003

Я как участник вас прощаю, но помочь без файла не смогу.
Файл-пример - это одно из главных правил. Нет файла - нет помощи. Как сделать пример есть в правилах.

Номер мобильного модема (без голосовой связи)
9269171249 МегаФон, Московский регион.

Ответить

БодрыйБабуин

Дата: Четверг, 21.03.2013, 18:52 | Сообщение № 3

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

Репутация: 0 ±

Замечаний: 0% ±

Цитата (AlexM)

Добавил файл-пример.

Ответить

AlexM

Дата: Четверг, 21.03.2013, 19:39 | Сообщение № 4

Группа: Друзья

Ранг: Участник клуба

Сообщений: 4513

Репутация: 1128 ±

Замечаний: 0% ±

Excel 2003

Макрос
[vba]

Код

Sub Macros()
Dim i As Long, n As Long
Application.ScreenUpdating = False
For i = Columns(1).End(xlDown).Row To 2 Step -1
       On Error Resume Next ' при n=0 пропустит строку с ошибкой
       'n = UBound(Split(Range("B" & i), ";")) 'n можно определять такой строкой
       n = Len(Range("B" & i)) - Len(Replace(Range("B" & i), ";", ""))
       Rows(i).Copy
       Rows(i).Resize(n).Insert Shift:=xlDown
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

[/vba]

К сообщению приложен файл: 5316860_new.xls (48.0 Kb)

Номер мобильного модема (без голосовой связи)
9269171249 МегаФон, Московский регион.

Сообщение отредактировал AlexM - Четверг, 21.03.2013, 21:27

Ответить

БодрыйБабуин

Дата: Четверг, 21.03.2013, 22:37 | Сообщение № 5

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

Репутация: 0 ±

Замечаний: 0% ±

Файл работает. Спасибо за помощь.

Ответить

Страница 1 из 1
1