Написать макрос для Excel
3230
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
Сейчас читают
Кофейня "МОКУМЕ"
225910
1000
красота и материнство (часть 21)
170642
1000
Красота и беременность (часть 31)
173983
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 *приятным* в итоге вываливается в очередной гимор разработчика.
Возможно. Просто за всё время применения данного метода я ни разу не испытывал подобных проблем
> Просто за всё время применения данного метода я ни разу не испытывал подобных проблем
Это все зависит от привычек конкретного пользователя. В один прекрасный день пользователь сделает что-нибудь необычное, и подобный глюк может поставить на уши целую организацию.
Это все зависит от привычек конкретного пользователя. В один прекрасный день пользователь сделает что-нибудь необычное, и подобный глюк может поставить на уши целую организацию.