На информационном ресурсе применяются cookie-файлы. Оставаясь на сайте, вы подтверждаете свое согласие на их использование.
Написать макрос для Excel
3317
14
Господа, программисты, не дайте умереть за компом!
Помогите (напишите), если не сложно парочку маааленьких макросов для Excel
Есть таблица, в которой некоторое количество столбцов (например, A:AZ) и много строк (около тысячи). Среди столбцов есть один (пусть будет Z), ячейки которого имеют целые значения n (от 1 до 20).
Нужно два макроса:
1. Пробежаться по ячейкам столбца Z. Если значение ячейки >1, то добавить под этой строкой (в которой находится данная ячейка) (n-1) пустых строк. Т.е. Если в ячейке Z25 стоит значение 7, то добавить после 25-й строки 6 пустых строк.
2. И второй макрос в продолжение первого (думаю тоже не сложный). Пробежаться по ячейкам первого столбца (A). Если ячейка оказалась пустой, то скопировать ячейки A:AZ из предыдущей строки в данную. Скопировать именно не всю строку, а только от A до AZ. Остальные стобцы должны остаться неизменными.
Помогите такое чудо сотворить, а то у меня вручную терпежу не хватит перелопатить эту долбаную таблицу! Там больше половины строк имеют n>1
Помогите (напишите), если не сложно парочку маааленьких макросов для Excel
Есть таблица, в которой некоторое количество столбцов (например, A:AZ) и много строк (около тысячи). Среди столбцов есть один (пусть будет Z), ячейки которого имеют целые значения n (от 1 до 20).
Нужно два макроса:
1. Пробежаться по ячейкам столбца Z. Если значение ячейки >1, то добавить под этой строкой (в которой находится данная ячейка) (n-1) пустых строк. Т.е. Если в ячейке Z25 стоит значение 7, то добавить после 25-й строки 6 пустых строк.
2. И второй макрос в продолжение первого (думаю тоже не сложный). Пробежаться по ячейкам первого столбца (A). Если ячейка оказалась пустой, то скопировать ячейки A:AZ из предыдущей строки в данную. Скопировать именно не всю строку, а только от A до AZ. Остальные стобцы должны остаться неизменными.
Помогите такое чудо сотворить, а то у меня вручную терпежу не хватит перелопатить эту долбаную таблицу! Там больше половины строк имеют n>1

*Скопировать именно не всю строку, а только от A до AZ*
точно от A до AZ? Это же вся строка таблицы получается и насчет остальных колонок замечание тогда не понятно.
точно от A до AZ? Это же вся строка таблицы получается и насчет остальных колонок замечание тогда не понятно.
*Скопировать именно не всю строку, а только от A до AZ*Замечание верное. Написал не совсем корректно, учитывая, что вся таблица состоит из столбцов от A до AZ.
точно от A до AZ? Это же вся строка таблицы получается и насчет остальных колонок замечание тогда не понятно.
На самом деле, это не настолько Важно. Таблицу можно было бы увеличить на пару столбцов... Ну, да ладно.
Пусть будет так: "Скопировать именно не всю строку, а только от A до AS. Остальные столбцы AT:AZ должны остаться неизменными"
Это первый:
Sub Макрос1()
b = 0
Row = 0
Do While b < 100
Row = Row + 1
rc = ActiveSheet.Cells(Row, 26).Value
If rc > 0 Then
For cnt = 1 To rc
ActiveSheet.Cells(Row, 1).Offset(1, 0).EntireRow.Insert
Next
End If
If IsEmpty(ActiveSheet.Cells(Row, 1)) Then
b = b + 1
End If
Loop
End Sub
А зачем тебе два отдельных? можно же сделать все в одном, или там какие-то дополнительные действа?
Sub Макрос1()
b = 0
Row = 0
Do While b < 100
Row = Row + 1
rc = ActiveSheet.Cells(Row, 26).Value
If rc > 0 Then
For cnt = 1 To rc
ActiveSheet.Cells(Row, 1).Offset(1, 0).EntireRow.Insert
Next
End If
If IsEmpty(ActiveSheet.Cells(Row, 1)) Then
b = b + 1
End If
Loop
End Sub
А зачем тебе два отдельных? можно же сделать все в одном, или там какие-то дополнительные действа?
Во-первых, сразу спасибо! Правда, еще не посмотрел
Во-вторых, два коротких проще рассмотреть
Хочется еще и понять что и как. Я как то пытался разобрать один (изучить) как пример, но так и ничего не понял. Он был на пол-страницы. А так два коротеньких осилю в понимании, думаю. Смотришь, сам чего смастерю потом.


второй завтра накидаю - сейчас убегаю.
а в первый чуток подправлю? а то критерий окончания таблицы будет не 100 пустых строк подряд, а всего встреча 100 пустых строк в таблице
Sub Макрос1()
b = 0
Row = 0
Do While b < 100
Row = Row + 1
rc = ActiveSheet.Cells(Row, 26).Value
If rc > 0 Then
For cnt = 1 To rc
ActiveSheet.Cells(Row, 1).Offset(1, 0).EntireRow.Insert
Next
End If
If IsEmpty(ActiveSheet.Cells(Row, 1)) Then
b = b + 1
else
b=0
End If
Loop
End Sub
а в первый чуток подправлю? а то критерий окончания таблицы будет не 100 пустых строк подряд, а всего встреча 100 пустых строк в таблице

Sub Макрос1()
b = 0
Row = 0
Do While b < 100
Row = Row + 1
rc = ActiveSheet.Cells(Row, 26).Value
If rc > 0 Then
For cnt = 1 To rc
ActiveSheet.Cells(Row, 1).Offset(1, 0).EntireRow.Insert
Next
End If
If IsEmpty(ActiveSheet.Cells(Row, 1)) Then
b = b + 1
else
b=0
End If
Loop
End Sub
гы, чуть не забыл
Sub Макрос2()
b = 0
Row = 0
br = 0
er = 0
Do While b < 100
Row = Row + 1
If IsEmpty(ActiveSheet.Cells(Row, 1)) Then
b = b + 1
If br = 0 Then
br = Row
er = Row
Else
er = Row
End If
Else
b = 0
If br <> 0 Then
ActiveSheet.Range("A" & br - 1 & ":AS" & br - 1).Copy
ActiveSheet.Range("A" & br & ":AS" & er).Select
ActiveSheet.Paste
Application.CutCopyMode = False
br = 0
er = 0
End If
End If
Loop
End Sub

Sub Макрос2()
b = 0
Row = 0
br = 0
er = 0
Do While b < 100
Row = Row + 1
If IsEmpty(ActiveSheet.Cells(Row, 1)) Then
b = b + 1
If br = 0 Then
br = Row
er = Row
Else
er = Row
End If
Else
b = 0
If br <> 0 Then
ActiveSheet.Range("A" & br - 1 & ":AS" & br - 1).Copy
ActiveSheet.Range("A" & br & ":AS" & er).Select
ActiveSheet.Paste
Application.CutCopyMode = False
br = 0
er = 0
End If
End If
Loop
End Sub
Сейчас читают
Ночной дозор
384454
1491
Новый дом - новая жизнь
114186
524
Красота и беременность (часть 63)
214662
1000
Классно! Второй работает отлично! А вот первый чего то у меня не фурычит...
Вообще никакой реакции, никаких изменений...
Хотя, я кажется немного промахнулся со столбцом... Прошу прощения!
Вопрос. Где задается столбец, в котором нужно смотреть количество добавочных строк?
rc = ActiveSheet.Cells(Row, 26).Value
Число 26 определяет, нет?
Да, и маленькая поправка. Если стоит число 1, то добавлять строки не нужно. Это как подправить?

Хотя, я кажется немного промахнулся со столбцом... Прошу прощения!
Вопрос. Где задается столбец, в котором нужно смотреть количество добавочных строк?
rc = ActiveSheet.Cells(Row, 26).Value
Число 26 определяет, нет?
Да, и маленькая поправка. Если стоит число 1, то добавлять строки не нужно. Это как подправить?
Т.е. количество добавочных строк должно быть (n-1). Сейчас, какое число стоит, столько строк и добавляется...
Можно, конечно исправить сам столбец... Но мне хочется понять еще и сам макрос
Можно, конечно исправить сам столбец... Но мне хочется понять еще и сам макрос

а то критерий окончания таблицы будет не 100 пустых строк подряд, а всего встреча 100 пустых строк в таблицеЗачем так сложно?
Excel может сам сказать номер последней используемой строки:
LastRow = Cells.SpecialCells(xlLastCell).Row
К сожалению, Excel выдает номер последней когда-нибудь используемой строки. Т.е. если вы с троке 65536 вы когда-нибудь нажали пробельчик, то именно эту строчку вам вернет LastRow = Cells.SpecialCells(xlLastCell).Row (или Ctrl_End).
Вероятность такого события черезвычайно мала. А вот реализация намного понятней
Я пришел к этому не от досужих размышлений, а сделав выводы из практического опыта. Очень многое, к сожалению, задекларированное в MSOffice *приятным* в итоге вываливается в очередной гимор разработчика.
Возможно. Просто за всё время применения данного метода я ни разу не испытывал подобных проблем
> Просто за всё время применения данного метода я ни разу не испытывал подобных проблем
Это все зависит от привычек конкретного пользователя. В один прекрасный день пользователь сделает что-нибудь необычное, и подобный глюк может поставить на уши целую организацию.
Это все зависит от привычек конкретного пользователя. В один прекрасный день пользователь сделает что-нибудь необычное, и подобный глюк может поставить на уши целую организацию.