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，如果有道理

任何帮助将不胜感激

谢谢

托马斯

Answer 1

将尝试调整找到的最后一列以支持此操作，如果相邻单元格为空，则只需处理一个错误：

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 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 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

只有第一张桌子会受到影响。

VBA代码可自动填充右侧的公式，如果满足某些条件，该公式将停止

4 个答案: