双击自动填充 – 基于相邻单元格的dynamic

我需要去做：

我在Excel中使用正常的自动填充function（双击单元格边上的点）将内容复制到子单元格，因此在这种情况下单击单元格A1中的点将执行此操作：

我需要一个脚本，将重复整个列的过程，直到相邻的单元格中没有更多的值。

Answer 1

想必这是你要找的东西：

 Option Explicit Sub FillInTheBlanks() Dim StartCell As Range, EndCell As Range Set StartCell = ActiveCell Set EndCell = ActiveSheet.Cells(ActiveSheet.UsedRange.Rows.Count + 1, StartCell.Offset(0, 1).Column).End(xlUp) Dim currentText As String Dim i As Long For i = StartCell.Row To EndCell.Row If Not IsEmpty(ActiveSheet.Cells(i, StartCell.Row)) Then currentText = ActiveSheet.Cells(i, StartCell.Row).Text Else ActiveSheet.Cells(i, StartCell.Row).Value = currentText End If Next i End Sub 

该代码执行以下操作：

---

如果你真的想要什么在你的截图，那么你需要这样做：

 Option Explicit Sub FillInTheBlanks() Dim StartCell As Range, EndCell As Range, NextCell As Range Set StartCell = ActiveCell Set EndCell = Cells(ActiveSheet.UsedRange.Rows.Count + 1, StartCell.Offset(0, 1).Column).End(xlUp) While StartCell.Row < EndCell.Row Set NextCell = StartCell.Offset(1, 1).End(xlDown).Offset(0, -1) StartCell.AutoFill Destination:=ActiveSheet.Range(StartCell, NextCell), Type:=xlFillDefault Set StartCell = NextCell.Offset(1, 0) Wend End Sub 

这是什么：

Answer 2

你可以从键盘上做到这一点…

• select列A
• select首页| 查找并select| 转到特别…空白确定
• 按[=] [向上箭头] [ctrl + Enter]

要删除公式，请select列A，复制并粘贴特殊值。