请帮忙写一个VBA，任意单元格下方插入一行并延续公式

qmlyc1

请帮忙写一个VBA，在任意单元格下方插入一行，并复制F列公式切保证插入行下行的公式自动变化

qmlyc1

已解决：
Private Sub CommandButton1_Click()
If TypeName(Selection) = "Range" Then
        cRow = Selection.Row
        Set rngOfSum = Range("A" & cRow & ":G" & cRow)
    End If
    rngAddress = "f:f" '修改此处：可选择公式所在列。
    num = Application.InputBox(prompt:="请输入要增加的行数：", Type:=1)
    If TypeName(num) <> "Boolean" Then
        Set rngUpOfSum = rngOfSum.Offset(-1, 0)
        Set temp = rngOfSum.Resize(num, rngOfSum.Columns.Count)
        temp.Insert shift:=xlDown, copyorigin:=xlFormatFromLeftOrAbove
        rngUpOfSum.Copy
        temp.Offset(-1 * num, 0).PasteSpecial Paste:=xlPasteFormats, operation:=xlNone
        Application.Intersect(Range(rngAddress), rngUpOfSum).Resize(num + 2, 1).Select
        Selection.FillDown
        Application.CutCopyMode = False
    End If
End Sub

3190496160

Sub 插入行()
With ActiveSheet
    r = Selection.Row
    If r < 5 Then MsgBox "请选择表格区域！": End
    Rows(r).Insert Shift:=xlDown
    Range("F" & r).FormulaR1C1 = "=IF(RC[-2]+RC[-1]=0,"""",R[-1]C+RC[-2]-RC[-1])"
End With
MsgBox "ok!"
End Sub

3190496160

3190496160

Book1.rar (16.29 KB, 下载次数: 2)

2023-2-5 16:15 上传

点击文件名下载附件

3190496160

选定需要插入行的任一单元格，然后点击按钮即可

3190496160

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.EntireRow.Address = Target.Address Then
    r = Selection.Row
    If r < 5 Then MsgBox "请选择表格区域！": End
    Rows(r).Insert Shift:=xlDown
    Range("F" & r).FormulaR1C1 = "=IF(RC[-2]+RC[-1]=0,"""",R[-1]C+RC[-2]-RC[-1])"
End If
End Sub

3190496160

选定整行自动插入，无需按钮也行
Book1.rar (18.76 KB, 下载次数: 3)

2023-2-5 16:18 上传

点击文件名下载附件

3190496160

准提部林

插入行後, 底下的公式就不是上下格參照了~~
1) 要嘛, 整列重刷公式
2) 或換個遞增參照公式, 但效率較差!!