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 在右側），當我嘗試使用表 1 中的宏時，我不希望它覆蓋表 2 中的數據，如果那樣的話說得通

任何幫助將非常感激

謝謝，

托馬斯

Answer 1

將嘗試調整最后一列 find 以支持這一點，如果相鄰單元格為空，則只需要處理錯誤：

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

---

編輯2：

使用 .fill 正確：

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 2

你試過 Ctrl + R 嗎？ 我知道這不完全是你要找的，但似乎它可能是最簡單的解決方案

Answer 3

在我看來，您只需要一種不同的方式來找到最后一列。

此公式將為您提供仍然存在數據的最接近的列，這意味着緊隨其后的是空白或與當前列合並。

dim row as long: row = 1 'the row number where you want to do the test
dim colOrigin as long: colOrigin = 1 'the starting column from where you want to check
with ThisWorkbook.ActiveSheet
    lColumn = .Cells(row, Application.Min(.Cells(row, colOrigin).End(xlToRight).Column + 1, Columns.Count)).End(xlToLeft).Column
end with

如果您需要從不同的位置開始，您可以對其進行調整。

Answer 4

您可以只使用以下而不是 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

只有第一個表會受到影響。