Страницы: 1
RSS
Автозаполнение нумерации до конца смежного столбца
 
Добрый день, коллеги.
Прошу подсказать, задача такая, у меня есть столбец В в котором нужно написать п1 в последней незаполненной ячейке (это я сделал). Рядом есть столбец С, в котором уже содержатся данные и их больше чем в столбце В. Нужно сделать автозаполнение столбца В, чтобы он заполнился п1, п2, п3... (при этом всегда количество заполняемой информации разное, может быть 2 пункта а может 25) по количеству заполненных ячеек в смежном столбце С.
Получилось вот так, но ругается на последнюю строчку эксель:
Код
Sub Num()
  Range("B1").Select
    Dim iLastRow2 As Long
   Application.ScreenUpdating = False
    iLastRow2 = Cells(Rows.Count, 2).End(xlUp).Row
    Cells(iLastRow2 + 1, 2).Select
     Application.ScreenUpdating = True
    ActiveCell.FormulaR1C1 = "i1"
     Dim iLastRow1 As Long
   Application.ScreenUpdating = False
       iLastRow1 = Cells(Rows.Count, 3).End(xlUp).Row
       Cells(iLastRow1 + 1, 3).Select
Range("B1:B").AutoFill Destination:=Range(iLastRow2, iLastRow1)
End Sub
Изменено: stsergey - 04.04.2020 19:35:36
 
Добрый день! Приложите файл, и нам понятнее будет
Изменено: Dmitriy XM - 04.04.2020 19:37:38
 
Вот файл, еще было бы совсем хорошо, если в столбце А, протягивалось Глава2, около п1.
 
stsergey, так7
Код
Sub Num()
  Range("B1").Select
    Dim iLastRow2 As Long
   Application.ScreenUpdating = False
    iLastRow2 = Cells(Rows.Count, 2).End(xlUp).Row
    Cells(iLastRow2 + 1, 2).Select
     Application.ScreenUpdating = True
    ActiveCell.FormulaR1C1 = "i1"
     Dim iLastRow1 As Long
   Application.ScreenUpdating = False
       iLastRow1 = Cells(Rows.Count, 3).End(xlUp).Row
       Cells(iLastRow1 + 1, 3).Select
Range("B" & iLastRow2 - 1 & ":B" & iLastRow2).AutoFill Destination:=Range("B" & iLastRow2 - 1 & ":B" & iLastRow1)
End Sub
Изменено: Mershik - 04.04.2020 20:19:47
Не бойтесь совершенства. Вам его не достичь.
 
Я планировал, что он будет начинать нумерацию с п1, а макрос ее продолжает. Хотя вроде как п1 ставится в активную ячейку.
 
stsergey, ничего не понятно, опишите нормально вашу задачу... и покажите в файле что есть и сто должно получиться ! две так сказать таблички
так?
Код
Sub numerciya()
Dim i As Double
Application.ScreenUpdating = False
LR2 = Cells(Rows.Count, 3).End(xlUp).Row
    For i = 2 To LR2
        Cells(i, 2) = "п." & i - 1
        If Cells(i, 1) = "" Then
        Cells(i, 1) = Cells(i - 1, 1)
        End If
    Next i
Application.ScreenUpdating = True
End Sub

Изменено: Mershik - 05.04.2020 09:57:25
Не бойтесь совершенства. Вам его не достичь.
 
Код
Sub Tablica()
Dim iLastRowB As Long
Dim iLastRowC As Long
Dim n As Long
 iLastRowB = Cells(Rows.Count, "B").End(xlUp).Row
 iLastRowC = Cells(Rows.Count, "C").End(xlUp).Row
   n = 1
 Do
   Cells(iLastRowB + n, "A") = "Глава2"
   Cells(iLastRowB + n, "B") = "n" & n
    n = n + 1
 Loop While n < iLastRowC - iLastRowB + 1
End Sub
 
Mershik, смотрите, я написал макрос который подтягивает данные из из ворд файла (именно данные в табличной форме). Теперь мне надо, чтобы в столбце А шло название главы, она всегда +1 от предыдущей и протягивается на все пункты. т.е. глава 1 содержит пункты 1-10 (пример) (пункты указываются в столбце В), дальше в столбце А - Глава1 +1 (Глава2) содержит п1-8 (пример). Соответственно, надо чтобы в столбце А к названию главы прибавлялось +1 и протягивалось на все пункты, в столбце В шла нумерация пунктов каждый раз с п1, когда начинается новая глава (при автоматическом подтягивании данных из ворд). В связи тем, что каждый раз количество строк разное я планировал ориентироваться по столбцу С, исходя из него нумеровать столбец В, а исходя из него протягивать столбец А. Как должно быть и как есть файлы прилагаю.
Изменено: stsergey - 05.04.2020 11:43:04
 
Цитата
stsergey написал:
Как должно быть и как есть файлы прилагаю
А зачем два (ДВА!) файла качать? Ведь можно в одном на разных листах показать.
 
Kuzmich, вот так отлично, только глава не всегда 2, а постоянно меняется но +1 от предыдущей)
 
Цитата
только глава не всегда 2, а постоянно меняется но +1 от предыдущей
Код
Sub Tablica()
Dim iLastRowB As Long
Dim iLastRowC As Long
Dim n As Long
Dim Glava As String
 iLastRowB = Cells(Rows.Count, "B").End(xlUp).Row
 iLastRowC = Cells(Rows.Count, "C").End(xlUp).Row
   Glava = Left(Cells(iLastRowB, "A"), 5) & Mid(Cells(iLastRowB, "A"), 6) + 1
   n = 1
 Do
   Cells(iLastRowB + n, "A") = Glava
   Cells(iLastRowB + n, "B") = "n" & n
    n = n + 1
 Loop While n < iLastRowC - iLastRowB + 1
End Sub
 
Юрий, извиняюсь, был не прав)
Kuzmich, это великолепно, спасибо! от души!
Страницы: 1
Наверх