Excel - VBA填充第一个和最后一个值之间的单元格

Question

我正在尝试使用 VBA 将行中的所有空白单元格填充为左侧的值，但我只想填充行中第一个和最后一个值之间的空白单元格（不包括第 1 行和A 列，它们是标识符）。

我一直在努力让循环在到达具有值的最后一列时停止（因为这会随着每一行而变化），而不是一直运行到工作表上的最后一列。

最初这被标记为重复 (Autofill when there are blank values)，但这并不能解决上述问题。这一直持续到工作表结束。如下图所示，当达到最后一个值时，填充应该停止。

我正在寻找一种解决方案，可以让我一次对整个工作表执行此操作，即使数据在整个工作表的不同列中结束。有 1000 多行，因此为每一行运行可能会非常乏味。

我一直在使用此代码来填充数据（不包括第一行和第一列）。但这是我不确定如何让它停在行中的最后一个值的地方。

Sub test()
With ThisWorkbook.Sheets("Sheet1").Range("A:A")
    With Range(.Cells(2, 2), .Cells(.Rows.Count, 36).End(xlUp))
        With .Offset(0, 1)
            .Value = .Value
            On Error Resume Next
            .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[-1]&"""""
            On Error GoTo 0
            .Value = .Value
        End With
    End With
End With
End Sub

如果我的解释不清楚，这是一个示例和我正在尝试创建的输出

在此先感谢大家的帮助！

Answer 1

你可以试试这样的...

Sub FillBlanks()
Dim r As Long, lr As Long, lc As Long
Dim cell As Range, FirstCell As Range, LastCell As Range
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(2, Columns.Count).End(xlToLeft).Column
For r = 3 To lr
    Set FirstCell = Range(Cells(r, 1), Cells(r, lc)).Find(what:="*", after:=Cells(r, 1))
    If Not FirstCell Is Nothing And FirstCell.Column > 1 Then
        Set LastCell = Cells(r, Columns.Count).End(xlToLeft)
        Range(FirstCell, LastCell).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[-1]"
        Range(FirstCell, LastCell).Value = Range(FirstCell, LastCell).Value
    End If
Next r
End Sub

Answer 2

这里还有另一种解决方案（只是为了给你一些变化）：

Option Explicit

Sub fillInTheBlanks()

Dim lngRow As Long
Dim ws As Worksheet
Dim lngColumn As Long
Dim bolStart As Boolean
Dim lngLastColumn As Long
Dim dblTempValue As Double
Dim arrSheetCopy As Variant

Set ws = ThisWorkbook.Worksheets("Sheet1")
arrSheetCopy = ws.Range(ws.Cells(3, 1), ws.Cells(ws.Cells(ws.Rows.Count, "A").End(xlUp).Row, ws.UsedRange.Columns.Count)).Value2

For lngRow = LBound(arrSheetCopy, 1) To UBound(arrSheetCopy, 1)
    bolStart = False
    lngLastColumn = 0
    For lngColumn = LBound(arrSheetCopy, 2) To UBound(arrSheetCopy, 2)
        If Not arrSheetCopy(lngRow, lngColumn) = vbEmpty Then lngLastColumn = lngColumn
    Next lngColumn
    For lngColumn = LBound(arrSheetCopy, 2) To lngLastColumn
        If arrSheetCopy(lngRow, lngColumn) = vbEmpty And bolStart Then
            arrSheetCopy(lngRow, lngColumn) = dblTempValue
        Else
            If Not arrSheetCopy(lngRow, lngColumn) = vbEmpty And IsNumeric(arrSheetCopy(lngRow, lngColumn)) Then
                bolStart = True
                dblTempValue = CDbl(arrSheetCopy(lngRow, lngColumn))
            End If
        End If
    Next lngColumn
Next lngRow

ws.Range("A3").Resize(UBound(arrSheetCopy, 1), UBound(arrSheetCopy, 2)).Value2 = arrSheetCopy

End Sub

这可能是最快的解决方案（尽管与其他解决方案相比，它看起来有点笨重，代码行数更多）。这是因为这个解决方案在内存中完成了大部分工作，而不是在工作表上。整个工作表被加载到一个变量中，然后在将结果（变量）写回工作表之前对变量完成工作。因此，如果您遇到速度问题，那么您可能需要考虑使用此解决方案。

Answer 3

这是满足您的样本数据预期的一种可能。

Sub wqewqwew()
    Dim i As Long, fc As Variant, lc As Long

    'necessary if you do not want to confirm numbers and blanks in any row
    On Error Resume Next

    With ThisWorkbook.Worksheets("Sheet6")
        For i = 3 To .Cells(.Rows.Count, "A").End(xlUp).Row
            If CBool(Application.Count(Rows(i))) Then
                fc = Intersect(.Rows(i), .UsedRange).Offset(0, 1).SpecialCells(xlCellTypeConstants, xlNumbers).Cells(1).Column
                If Not IsError(fc) Then
                    lc = Application.Match(9 ^ 99, .Rows(i))
                    On Error Resume Next
                    With .Range(.Cells(i, fc), .Cells(i, lc))
                        .SpecialCells(xlCellTypeBlanks).Cells.FormulaR1C1 = "=RC[-1]"
                        .Value = .Value2
                    End With
                End If
            End If
        Next i
    End With

End Sub

Answer 4

只是另一种解决方案：

以下代码可以帮助您是否需要根据问题 Excel 中提到的第一个单元格的值自动填充第一个和最后一个单元格之间的先前值 - VBA 填充第一个和最后一个值之间的单元格

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim i As Long
    For i = 2 To Target.Column
        If Cells(Target.Row, i) = "" Then
            If Cells(Target.Row, i - 1) <> "" Then
                Range(Cells(Target.Row, i), Cells(Target.Row, i)).Value = Range(Cells(Target.Row, i - 1), Cells(Target.Row, i - 1)).Value
            End If
        End If
    Next i
End Sub

通过单击任何单元格来激活此子项。相同的单元格标记循环的结束，即停止循环只需单击要填充空白单元格的单元格。