Excel – VBA在第一个和最后一个值之间填入单元格
我正在尝试使用VBA来填充左侧值的行中的所有空白单元格，除了我只想填充行中的第一个和最后一个值之间的空白单元格（不包括行1和列A，这是标识符）。
我一直努力得到循环停止，一旦有一个值的最后一列已经达到（因为这与每行改变），而不是一直运行在工作表的最后一列。
最初这被标记为重复（ 自动填充时，有空白值 ），但这并不能解决上述问题。 这一直持续到工作表结束。 如下图所示，当达到最后一个值时，填充应该停止。
我正在寻找一种解决scheme，可以让我一次完成整个工作表，即使数据在整个工作表的不同列中结束。 有超过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 如果我的解释不清楚，这是一个示例和我试图创build的输出 
提前谢谢大家的帮助！
还有另一个解决scheme（只是为了给你一些变化）：
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
这个可能是最快的解决scheme（尽pipe与其他解决scheme相比，它看起来有点庞大，代码行数更多）。 这是由于这个解决scheme在内存中而不是在表单上执行的大部分工作。 整个工作表被加载到一个variables中，然后在结果（variables）被写回工作表之前，在variables上完成工作。 所以，如果你有速度问题，那么你可能要考虑使用这个解决scheme。
你可以尝试这样的事情…
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
这里有一个可能符合你的样本数据的期望。
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
另一个解决scheme：
下面的代码可以帮助你在第一个和最后一个单元格之间根据第一个单元格的值自动填充以前的值，如问题中提到的那样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
通过点击任何单元格来激活这个子。 相同的单元格标记循环的结束，即停止循环，只需单击要填充空白单元格的单元格。