Автоматическая нумерация строк в Excel по порядку с помощью VBA

Каждый знает, как проставить нумерацию строк в excel. Для этого достаточно поставить первые две цифры, выделить их и потянуть за появившийся в правом нижнем углу выделенной области черный квадрат. Все нумерация готова.

ручная нумерация строк
Вот так делается ручная нумерация строк

Но когда возникает необходимость делать эту процедуру часто, или ввиду обилия нескольких разделов и подразделов – ручная нумерация строк в таблице excel превращается в скучную рутинную работу. И гораздо приятнее написать макрос нумерации строк excel и наслаждаться результатом через долю секунды.

нумерация строк используя макрос vba
excel vba автоматическая нумерация строк

Работоспособный макрос нумерации строк в excel по порядку приведен ниже:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Обновить нумерацию
If ActiveCell.Column = 10 And Cells(ActiveCell.Row, ActiveCell.Column).Value = "Обновить нумерацию" And ActiveCell.Row = 2 Then
' ссылка на лист книги в котором обновляем нумерацию
Set pr = Workbooks("planero-s-avtomaticheskoj-numeraciej-strok.xlsm").Worksheets("Проекты")
i = 0 ' для работоспособности цикла
j = 1 ' номер задачи
k = 1 ' номер подзадачи
' проходим вниз по странице до тех пор, пока есть записи в ячейке "B3" или "C3"
Do While pr.Range("B3").Offset(i, 0) > 0 Or pr.Range("D3").Offset(i, 0) > 0
' если ячейка "В3"+i содержит текст
If pr.Range("B3").Offset(i, 0) > 0 Then
' нумеруем ее
pr.Range("A3").Offset(i, 0) = j
' выделяем номер жирным
pr.Range("A3").Offset(i, 0).Font.Bold = True
' увеличиваем переменную j на единицу
j = j + 1
' обнуляем номер подзадачи
k = 1
' если ячейка "B3"+i пустая, следовательно мы имеем дело с подзадачей
Else
' если ячейка "D3"+i содержит текст
If pr.Range("D3").Offset(i, 0) > 0 Then
' нумеруем ее
pr.Range("C3").Offset(i, 0) = k
' увеличиваем номер подзадачи на единицу
k = k + 1
End If
End If
' увеличиваем i на +1 чтобы проверить следующию ячейку (расположенную ниже) на наличие записи
i = i + 1
Loop
' убираем курсор с кнопки
pr.Cells(ActiveCell.Row, ActiveCell.Column - 2).Select
End If
End Sub

Первым делом привязываем запуск макроса при нажатии на кнопку «Обновить нумерацию». Далее запускаем цикл и выполняем его до тех пор, пока ячейка B3 и D3 содержит текст. При этом последовательно перемещаемся к ниже идущим ячейкам от B3 и D3, используя Offset и переменную i: .offset(i, 0). Одновременно с этим, нумеруем задачи (если B3+i содержит текст) и подзадачи (если B3+i не содержит текст, при этом содержит текст D3+i). Ну и напоследок убираем курсор с кнопки «Обновить нумерацию».

Саму экселевсую книгу с макросом автоматической нумерации можно скачать по этой ссылке. На этом все. Остались вопросы – задавайте их в комментариях. С другими кейсами по автоматизации можно ознакомиться здесь.

Поделись с друзьями:
Комментарии 2

© планеро.ru