'Нумерация по порядку необъединённых видимых ячеек первого столбца
'Автор: Sanja
'На основе макроса от: Tebenkov Igor
'Тема на форуме: http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=82499&TITLE_SEO=82499-numeratsiya-s-diapazonami-i-bez-ignoriruya-obedinyennye-yacheyki&MID=689121&result=edit#message689121
'====================================================================================================================================================================================================================
Sub AutoNumAMerge()

Dim iCell As Range
Dim I As Long
Dim lRow As Long

Application.ScreenUpdating = False

lRow = Cells(Rows.Count, 2).End(xlUp).Row
For Each iCell In Range("A2:A" & lRow).Cells
    With iCell
        If Not .MergeCells And Not .Rows.EntireRow.Hidden Then
            I = I + 1
            iCell.Value = I
        End If
    End With
Next

Application.ScreenUpdating = True

End Sub

Sub AutoNumInReg()

Dim iCell As Variant
Dim leftcell As String
Dim upcell As String
Dim strDelim As String

strDelim = Application.InputBox("Введите символ-разделитель", "Определение разделителя")
    If strDelim = "10" Then strDelim = Chr(10)
    If strDelim = "" Then End

iCell = ActiveCell
leftcell = ActiveCell(, 0)
upcell = ActiveCell(0)

Selection.Cells(1).Value = 1

For Each iCell In Selection

If InStr(upcell, strDelim, 1) <> 0 And leftcell > 1 Then
iCell = Value.Split(upcell, strDelim)(1) + 1 & strDelim & Value.Split(upcell, strDelim)(1) + Value.leftcell
iCell = Value.iCell

ElseIf InStr(upcell, strDelim, 1) <> 0 And leftcell = 1 Then
iCell = Value.Split(upcell, strDelim)(1) + 1
iCell = Value.iCell

ElseIf InStr(upcell, strDelim, 1) = 0 And leftcell > 1 Then
iCell = Value.upcell + 1 & strDelim & Value.upcell + leftcell
iCell = Value.iCell

ElseIf InStr(upcell, strDelim, 1) = 0 And leftcell = 1 Then
iCell = Value.upcell + 1
iCell = Value.iCell

Else: End

Next
Next
Next
Next
End If
End If
End If
End If

End Sub

Sub AutoNumInRegister()

Dim cl As String
Dim leftcell As String
Dim upcell As String
Dim xRng As Range
Dim fromup As Integer
Dim finder As Byte

strDelim = "–"  'задаём разделитель между начальным и конечным номером (для мнгогострочных документов)

Set xRng = Selection

I = 1


cl = xRng.Cells(I)  'назначаем переменную для любой I ячейки выделенного диапазона
leftcell = xRng.Cells(I).Offset(0, -1)  'назначаем переменную для ячейки, слева от активной
upcell = xRng.Cells(I).Offset(-1, 0)    'назначаем переменную для ячейки, сверху от активной
fromup = Split(upcell, strDelim)(1).Value   'назначаем переменную для числа, взятого после разделителя из ячейки сверху от активной
finder = InStr(upcell, strDelim, 1) 'назначаем переменную для определения наличия разделителя в ячейке сверху от активной


If xRng.Cells(1, 0).Offset(0, -1) = 1 Then xRng.Cells(1, 0) = 1 'если число слева от первой ячейки = 1, то в первой ячейке 1
Else
xRng.Cells(1, 0) = 1 & strDelim & 1 + xRng.Cells(1, 0).Offset(0, -1).Value 'если нет, то "1разделитель1+число слева от первой ячейки (например, если в первом документе 5 страниц, то нумератор должен поставить "1-6", то есть с первой по шестую)

For I = 2 To xRng.Rows.Count     'цикл со второй ячейки и до конца выделенного диапазона

If finder <> 0 And leftcell > 1 Then    'если в ячейке выше активной присутствует разделитель и число слева больше 1, то…
cl = fromup + 1 & strDelim & fromup + leftcell     'значение в ячейке = число второе от разделителя в верхней ячейке + 1, разделитель, число второе от разделителя в верхней ячейке + число в левой ячейке


ElseIf finder <> 0 And leftcell = 1 Then    'если в ячейке выше активной присутствует разделитель и число слева = 1, то…
cl = fromup + 1    'значение в ячейке = число второе от разделителя в верхней ячейке + 1


ElseIf finder = 0 And leftcell > 1 Then    'если в ячейке выше активной нет разделителя и число слева больше 1, то…
cl = upcell + 1 & strDelim & upcell + leftcell    'значение в ячейке = число в верхней ячейке + 1, разделитель, число в верхней ячейке + число в левой ячейке


ElseIf finder = 0 And leftcell = 1 Then    'если в ячейке выше активной нет разделителя и число слева = 1, то…
cl = upcell + 1    'значение в ячейке = число в верхней ячейке + 1

Else: End   'если ни одно условие не выполняется, то выход

End If
Next I

End Sub