Question

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

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

最初这被标记为重复（Autofill when there are blank values），但这并未解决上述问题。这一直持续到纸张结束。如下图所示，填充应在达到最后一个值时停止。

我正在寻找一种解决方案，允许我立即对整张纸进行此操作，即使数据在整个工作表的不同列中结束。有1000多行，因此每行运行可能非常繁琐。

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

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

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

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 3

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

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

点击任何单元格即可激活此子目录。相同的单元格标记循环的结束，即停止循环，只需单击要填充空白单元格的单元格。

Excel - VBA在1st和Last值之间填充单元格

4 个答案: