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

而且这里又是另一种解决方案（只是给你一些品种）：

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 2

你可以试试这样的事情...

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

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