Excel vba нумерация ячеек

Также неочевидными оказались некоторые нюансы при вставке и удалении строк в таблице по нажатию на соответствующие кнопки (под таблицей будем понимать визуально выделенный  диапазон ячеек, содержащий связанные по смыслу данные). Например, у нас на листе есть две таблицы, у каждой есть кнопка «добавить строку». При добавлении для каждой строки появляется кнопка «удалить».

Маловероятно, что пользователь создаст за секунду более одной строки (в комплекте с кнопкой ее удаления) с одинаковым начальным номером строки.

Задача состоит в том, чтобы при сохранении файла проверять содержимое ячеек на всех листах и если какие-то помеченные как обязательные остались незаполненными, выдавать предупреждение пользователю. Для визуального выделения в зависимости от результата проверки содержимого ячеек на соответствие требованиям в excel можно использовать условное форматирование. Казалось бы, все просто: если мы используем условное форматирование и незаполненные ячейки (или неправильно заполненные, которые мы не смогли проверить при вводе с помощью меню «проверка данных») подкрашиваем, например, красным, то при сохранении все что нам нужно сделать — пройтись по всем ячейкам и проверить их цвет.

В голову пришло два слегка костыльных способа решения (и честно говоря, если судить по форумам с обсуждением подобных проблем, кажется, что применительно к Excel по-другому их и не решишь).

Первый способ: в одном столбце, напротив каждой строки таблицы, формулой вычисляется, правильно ли заполнена строка. Тогда, проходясь по этому столбцу, мы можем сказать, в какой строке проблема. А при помощи условного форматирования проблемные ячейки могут подсвечиваться красным. Этого достаточно, если не надо точно знать, в какой ячейке проблема. При необходимости можно дальше обрабатывать эту строку по ячейкам. Способ хорош, если разные строки проверяются на разные условия (даже в рамках одной таблицы).

usedRows = ActiveSheet.UsedRange.Rows.Count
usedCols = ActiveSheet.UsedRange.Columns.Count
‘ переводим последний столбец из цифры в букву
usedColsInNumb = Split(Cells(1, usedCols).Address, «$»)(1)

For Each cell In ActiveSheet.Range(«A1:» & usedColsInNumb & usedRows).Cells

   ‘ если колонка с результатом формулы проверки заполнена

   If Len(cell.Value) > 0 Then 

       ‘ если строка неправильно заполнена

       If cell.Value = «ЛОЖЬ» Then 

            ‘ сохраняем в массив, отражающий правильность 
            ‘ заполнения каждой строки
            notFilled(cell.Row) = True 

       End If

   End If

Next

Второй способ: изначально ячейки, значения которых необходимо проверять, выделять цветом. Далее, проходясь по всем ячейкам, искать выделенные и проверять на соответствие условиям. Тут также при помощи условного форматирования проблемные ячейки могут подсвечиваться красным. Этот способ проще, если все ячейки проверяем на одни и те же условия, иначе надо вводить несколько цветов или как-то иначе метить ячейки. Например, при помощи именованных диапазонов для каждой области с одинаковой проверкой.

For Each cell In Sheets(i).Range(«A2:» & usedColsInNumb & usedRows).Cells

    ‘ проверяем выделенные цветом ячейки на пустоту

    If cell.Interior.Color = Sheets(5).Cells(1, 6).Interior.Color   And Len(cell.Value) = 0 Then

        ‘ обработка незаполненной ячейки

    End If

Next

Тут надо учитывать, что при использовании объединенных ячеек Excel искренне полагает, что содержимое находится в первой из них. Поэтому проверять на пустоту нужно только первую  ячейку из диапазона.

‘ ищем смежные с текущей ячейки в виде интервала, eg «A1:B10»

mergedInterv = Cells(cell.Row, cell.Column).MergeArea.Address(RowAbsolute:=False, ColumnAbsolute:=False)

‘ разбиваем адрес на первую и последнюю из смежных

splitAr = Split(mergedInt, «:»)

‘ если текущая ячейка входит в объединенные

If UBound(splitAr) = 1 Then 

      splitAr2 = Split(cell.Address, «$»)

      ‘ если первая из диапазона смежных равна текущей ячейке

      If splitAr(0) = splitAr2(1) & splitAr2(2) Then

          ‘ обработка незаполненной смежной ячейки

      End If

Else 

    ‘ если текущая ячейка не является смежной

End If

При нахождении последней используемой строки или столбца следует учесть, что если вы каким-то образом успели «поиспользовать» интервал (пусть даже выделили и очистили формат), то он все равно считается использованным. Придется удалить эти строки и столбцы.

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

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

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

Работоспособный макрос нумерации строк в 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