Код VBA для автозаполнения формулы справа, которая останавливается при соблюдении определенных критериев

Question

В настоящее время я использую этот код для автоматического копирования и вставки формулы по строке в последний использованный столбец:

Sub Autofill_To_The_Right()
Dim lngLastColumn As Long
lngLastColumn = Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

Dim cell As Range
For Each cell In Selection.Columns(1).Cells
    Range(cell, Cells(cell.Row, lngLastColumn)).FillRight
Next

End Sub

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

У меня иногда есть таблицы, разделенные пустым столбцом (скажем, Таблица 1 слева и Таблица 2 справа), и яне хочу перезаписывать данные в таблице 2, когда я пытаюсь использовать макрос в таблице 1, если это имеет смысл

Любая помощь будет высоко ценится

Спасибо,

Thomas

Answer 1

Вы пробовали Ctrl + R?Я знаю, что это не совсем то, что вы ищете, но кажется, что это, вероятно, самое простое решение

Answer 2

попытается настроить последний столбец поиска для поддержки этого, который просто должен обработать ошибку, если соседняя ячейка пуста:

Dim r As Long, lr As Long, lc As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = 2 To lr
    If Not IsEmpty(Cells(r, 2).Value) Then
        lc = Cells(r, 1).End(xlToRight).Column
        Cells(r, 1).Copy Range(Cells(r, 2), Cells(r, lc))
    End If
Next r

---

Редактировать:

Аннотирующий код для дополнительной помощи.Обратите внимание, что вы можете также .fillright, используя этот метод, где последний столбец находится в строке.

Sub fsda()
    Dim r As Long, lr As Long, lc As Long 'iterating row, last row, last column
    lr = Cells(Rows.Count, 1).End(xlUp).Row 'dynamically find last row of column 1, removing need for ".select/.activate" efforts
    For r = 2 To lr  'assumes start in row 2 as header is in row 1
        If Not IsEmpty(Cells(r, 2).Value) Then  'check for column 2 to make sure it isn't blank... this is needed for 2 reasons: 1) to ensure you don't see 'last column' as the first column of next table to the right and 2) to ensure you don't get an infinite output for lc (no error, just goes on forever)
            lc = Cells(r, 1).End(xlToRight).Column  'find last column in specific row
            Cells(r, 1).Copy Range(Cells(r, 2), Cells(r, lc))  'copies, then pastes code into specified range
        End If
    Next r
End Sub

---

Edit2:

Использование .fill right:

Dim r As Long, lr As Long, lc As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = 2 To lr
    If Not IsEmpty(Cells(r, 2).Value) Then
        lc = Cells(r, 1).End(xlToRight).Column
        Range(Cells(r, 1), Cells(r, lc)).FillRight
    End If
Next r

Answer 3

Вы можете просто использовать следующее вместо lngLastColumn (когда вы начинаете с первого столбца в вашем коде):

Dim lngLastNonBlankColumn As Long
lngLastNonBlankColumn = Range("A1").End(xlToRight).Column

Dim cell As Range
For Each cell In Selection.Columns(1).Cells
   Range(cell, Cells(cell.Row, lngLastNonBlankColumn)).FillRight
Next

Будет затронута только первая таблица.

Answer 4

Мне кажется, что вам просто нужен другой способ найти последний столбец.

Эта формула даст вам ближайший столбец, в котором все еще есть данные, что означает, что следующий за ним либо пустой, либообъединено с текущим