Страницы: 1
RSS
Ввод уникального неповторяющегося номера строки по условию
 
Добрый вечер всем !
В книге 2 листа: лист "УчетДокументов" и лист "Выполнено"
В столбце А обоих листов находится нумерация строк - при этом нумерация уникальна:
те на обоих листах нет повторяющихся (одинаковых) номеров

Как на листе "УчетДокументов" в столбце А в первую незаполненную ячейку внести уникальный номер по условию:
собрать все номера внесенные на обоих листах в столбце А, вычислить последний самый больший номер N и присвоить в новую строку
номер N+1  ?

Макрос начал делать - но пока только определение 1 незаполненной ячейки
Код
Sub ПронумероватьСтолбецА()
Application.ScreenUpdating = False 'чтоб не моргало выключаем скрин
 Application.EnableEvents = False

 Dim i As Long, LastRow As Long
 LastRow = Cells(Rows.Count, 1).End(xlUp).Row
 Cells(LastRow + 1, 1).Select
 
 'Cells(LastRow + 1, 1).Value = ..... макрос выбора уникального номера ....
 


Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub


Файл с примером прилагаю.
 
Код
Sub t()
    x = Мяу
End Sub
Function Мяу&()
    Мяу = Application.Max((Sheets(1).Columns(1)), (Sheets(2).Columns(1)))
End Function
 
Чегото не заработало корректно

Код
Function Мяу&()
    Мяу = Application.Max((Sheets(1).Columns(1)), (Sheets(2).Columns(1)))
End Function

Sub ПронумероватьСтолбецА()
Application.ScreenUpdating = False 'чтоб не моргало выключаем скрин
 Application.EnableEvents = False

 Dim i As Long, LastRow As Long
 LastRow = Cells(Rows.Count, 1).End(xlUp).Row
 Cells(LastRow + 1, 1).Select
 Cells(LastRow + 1, 1).Value = Мяу
 'Cells(LastRow + 1, 1).Value = ..... макрос выбора уникального номера ....
 


Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
 
хм так заработало
Код
Function Мяу&()
    Мяу = Application.Max((Sheets("УчетДокументов").Columns(1)), (Sheets("Выполнено").Columns(1)))
End Function

Sub ПронумероватьСтолбецА()
Application.ScreenUpdating = False 'чтоб не моргало выключаем скрин
 Application.EnableEvents = False

 Dim i As Long, LastRow As Long
 LastRow = Cells(Rows.Count, 1).End(xlUp).Row
 Cells(LastRow + 1, 1).Select
 Cells(LastRow + 1, 1).Value = Мяу + 1
 'Cells(LastRow + 1, 1).Value = ..... макрос выбора уникального номера ....
 


Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
 
Благодарю RAN за помощь !
 
Я, грешным делом, подумал, что единичку прибавить вы и самостоятельно можете. :D
Страницы: 1
Наверх