Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Макрос: протяжка столбцов до последней заполненной строки (доработка)
 
Здравствуйте ув. эксперты. Снова нужна ваша помощь.

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

И маленькая просьба подсказать как весь макрос уменьшить и причесать до человеческого вида.. А то я на каждый столбце прописал отдельный код.. т.к не знаю как указать столбцы которые рядом стоят в одном коде.

Заранее огромное спасибо!
 
Gagarin13, Может так?...
Код
Option Explicit

Sub AutoFillToRow(rngBeg As Range, rEnd As Long)
Dim rngEnd As Range
With rngBeg
  If rEnd >= .Row Then
    Set rngEnd = .Resize(rEnd - .Row + 1)
  Else
    If rEnd < .Row Then Set rngEnd = .Offset(rEnd - .Row).Resize(.Row - rEnd + .Rows.Count)
  End If
  .AutoFill Destination:=rngEnd, Type:=xlFillDefault
End With
End Sub

Sub Заполнить()
Dim x, firstRowData As Long, rEnd As Long, rngUsed As Range, rngBeg As Range
Set rngUsed = ActiveSheet.UsedRange
firstRowData = 12 'первая строка данных в таблице
rEnd = rngUsed.Row + rngUsed.Rows.Count - 1 'последняя используемая строка на листе
For Each x In Array(1, 2, 5, 6, 13, 14, 15, 21) 'в каких столбцах нужен AutoFill
  Set rngBeg = Cells(firstRowData, x) 'за основу первая строка данных таблицы
'  Set rngBeg = Range(Cells(firstRowData, x), Cells(rEnd - 1, x))'за основу диапазон кроме последней строки данных таблицы
  AutoFillToRow rngBeg, rEnd
Next
End Sub

 
Если я Вас правильно понял, то можно так:
Код
Sub Протяжка()
    Dim i As Long, x As Range, q
    Application.ScreenUpdating = False
    Sheets("YD_Search").Activate
    i = Cells(Rows.Count, 8).End(xlUp).Row
    For Each q In Array(1, 2, 5, 6, 13, 14, 15, 21)
        Set x = Cells(Rows.Count, q).End(xlUp)
        If x.Row < 12 Then Set x = Cells(12, q)
        If x.Row < i Then x.AutoFill Range(x, Cells(i, q))
    Next
End Sub
Здесь массив содержит номера столбцов, по которым требуется делать "протяжку".
Если в каком-либо из этих столбцов заполненных строк больше, чем в 8-ом столбце, то "протяжки" в нем не будет.
Изменено: SAS888 - 17 Окт 2018 05:35:36
Чем шире угол зрения, тем он тупее.
 
AAF, SAS888, Огромное вам спасибо, оба макроса работаю вроде как нужно =)) Спасибо за оперативный ответ!!  
Страницы: 1
Читают тему (гостей: 1)
Наверх