快速向下求和（ＶＢＡ题目）

楼主罗刚君	Excel自带一个快速求和功能，快捷键为“Alt+=”。但它只能向上求和，现要求如下： 1.实现向下求和，即与“Ａlt+=“功能相近，但方向相反 2.需要用快捷键为“Alt+Z”来执行 3.可以选择一个单元格后向下求和，也可以在选择不连续的多单元格格后仍然快速向下求和 4.求和时，需要选择公式中的区域地址。例如公式是“=SUM("A12:A25")”，那么必须选中A12:A25。方便用户随意修改引用区域。样式见下图 5.要和防错功能，即不管用户操作是否规范，都不能有错误提示框。例如选择非单元格后执行，或者选择Ａ65536后执行。具体请看动画第一个回答者特奖励我正在淘宝店出售的着色工具5.0软件一套
2楼棉花糖	Sub sumdown() Dim cell As Range, Rng As Range On Error Resume Next Set Rng = Intersect(Selection.SpecialCells(xlCellTypeBlanks), UsedRange) If Err <> 0 Then Exit Sub If Rng Is Nothing Then Exit Sub For Each cell In Selection.SpecialCells(xlCellTypeBlanks) cell.Formula = "=sum(" & Range(cell.Offset(1, 0).Address, cell.Offset(1, 0).End(xlDown).Address).Address(0, 0) & ")" Next cell Application.SendKeys "{F2}" End Sub 快捷键没弄。
3楼罗刚君	离要求还有很大差距
4楼 hlxz	这个cell In Selection.SpecialCells(xlCellTypeBlanks)意思是取得当前第n个空行向下的第1个单元格地址→》cell.Offset(1, 0).Address 是取得当前第n个空行向下的非空的最后1个单元格-地址--》cell.Offset(1, 0).Address 所以用在快速向下求和这个不是很恰当
5楼 biaotiger1	水平有限，只能做到这个程度了。不知道能否满足要求工作表中代码如下 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.OnKey "%z", "aaa" End Sub 模块中代码如下 Sub aaa() 'MsgBox "aaa" Dim I As Integer, Rng As Range, Rng1 As Range On Error Resume Next 'Debug.Print Selection.Address 'If Error.num > 0 Then End For Each Rng1 In Selection If Len(Rng1.Offset(1, 0)) = 0 Then GoTo 1 If Application.CountA(Range(Rng1.Offset(1, 0), Cells(Rows.Count, Rng1.Column))) = 0 Then End Set Rng = Intersect(Rng1.Offset(1, 0).CurrentRegion, Range(Cells(1, Rng1.Column), Cells(Rows.Count, Rng1.Column))) Rng1.Formula = "=SUM(" & Rng.Address(0, 0) & ")" 1: Next For Each Rng1 In Selection If Len(Rng1) <> 0 Then Rng1.Activate: Exit For Next Application.SendKeys "{F2}{LEFT}+{HOME}+{RIGHT 5}" End Sub 有多个问题，楼下继续→-罗刚君快速向下求和.rar
6楼 biaotiger1	再加一句清除内容的代码Selection.ClearContents Sub aaa() Dim I As Integer, Rng As Range, Rng1 As Range On Error Resume Next Selection.ClearContents For Each Rng1 In Selection If Len(Rng1.Offset(1, 0)) = 0 Then GoTo 1 If Application.CountA(Range(Rng1.Offset(1, 0), Cells(Rows.Count, Rng1.Column))) = 0 Then End Set Rng = Intersect(Rng1.Offset(1, 0).CurrentRegion, Range(Cells(1, Rng1.Column), Cells(Rows.Count, Rng1.Column))) Rng1.Formula = "=SUM(" & Rng.Address(0, 0) & ")" 1: Next For Each Rng1 In Selection If Len(Rng1) <> 0 Then Rng1.Activate: Exit For Next Application.SendKeys "{F2}{LEFT}+{HOME}+{RIGHT 5}" End Sub
7楼皮皮1998	向下求和1.rar 题目到目前为止,还是觉得有疑问
8楼皮皮1998	呵呵
9楼 biaotiger1	更改了多列数据时选择单列求和的代码多个空白单元格？不明白什么意思，不计算，保持选中状态。这样可以吗？快速向下求和.rar 机器码.rar