[已解决]求在工作表的有内容区域右下角单元格合计区域内的行列的值

hcy1185

求在工作表的有内容区域右下角单元格合计区域内的行列的值
比如有内容区域为a1:h33
vba代码
在单元格i34填上"合计"
在i2:i33填上合计公式sum(b2:h2)
在b34:h34填上合计公式sum(b2:b33)
谢谢

最佳答案

月排行榜 / 总排行榜

mxg825

2012-4-5 09:53

1. 
   
2. Sub 区域汇总()
   
3. Dim rng As Range
   
4. Dim R%, C%
   
5. With ActiveSheet
   
6.    R = .UsedRange.Rows.Count    '有内容区域最大【行】号
   
7.    C = .UsedRange.Columns.Count '有内容区域最大【列】号
   
8.    On Error Resume Next
   
9.    Set rng = .UsedRange.SpecialCells(xlCellTypeLastCell).Offset(1, 1)
   
10.    If rng.Offset(-1, -1).Value = "合计" Then MsgBox "已填公式": Exit Sub
    
11.       rng = "合计"
    
12.       rng.Offset(1 - R, 0).FormulaR1C1 = "=SUM(RC[-" & C - 1 & "]:RC[-1])" '填入公式SUM(B2:H2)
    
13.          .Range(rng.Offset(1 - R, 0), rng.Offset(-1, 0)).FillDown '下拉填充公式
    
14. 
    
15.       rng.Offset(0, 1 - C).FormulaR1C1 = "=SUM(R[-" & R - 1 & "]C:R[-1]C)" '填入公式SUM(B2:B33)
    
16.          .Range(rng.Offset(0, 1 - C), rng.Offset(0, -1)).FillRight '右拉填充公式
    
17. End With
    
18. End Sub

复制代码

跳转到最佳答案楼层

mxg825

1. Sub MXG()
   
2. Dim R%, C%
   
3. R = UsedRange.Rows.Count '有内容区域最大【行】号
   
4. C = UsedRange.Columns.Count '有内容区域最大【列】号
   
5. Cells(R + 1, C + 1) = "合计"
   
6. Cells(2, C + 1).FormulaR1C1 = "=SUM(RC[-" & C & "]:RC[-1])" '填入公式SUM(B2:H2)
   
7. Range(Cells(2, C + 1), Cells(R, C + 1)).FillDown '下拉填充公式
   
8. 
   
9. Cells(R + 1, 1).FormulaR1C1 = "=SUM(R[-" & R - 1 & "]C:R[-1]C)" '填入公式SUM(B2:B33)
   
10. Range(Cells(R + 1, 1), Cells(R + 1, C)).FillRight '右拉填充公式
    
11. 
    
12. End Sub
    

复制代码

hcy1185

mxg825 发表于 2012-4-3 16:17

请问老师!
要求对象

mxg825

hcy1185 发表于 2012-4-3 16:24
请问老师!
要求对象

1. Sub MXG()
   
2. 
   
3. Dim R%, C%
   
4. 
   
5. R = UsedRange.Rows.Count '有内容区域最大【行】号
   
6. C = UsedRange.Columns.Count '有内容区域最大【列】号
   
7. 
   
8. Cells(R + 1, C + 1) = "合计"
   
9. 
   
10. Cells(2, C + 1).FormulaR1C1 = "=SUM(RC[-" & C - 1 & "]:RC[-1])" '填入公式SUM(B2:H2)
    
11. Range(Cells(2, C + 1), Cells(R, C + 1)).FillDown '下拉填充公式
    
12. 
    
13. Cells(R + 1, 2).FormulaR1C1 = "=SUM(R[-" & R - 1 & "]C:R[-1]C)" '填入公式SUM(B2:B33)
    
14. Range(Cells(R + 1, 2), Cells(R + 1, C)).FillRight '右拉填充公式
    
15. 
    
16. End Sub

复制代码

hcy1185

mxg825 发表于 2012-4-3 16:30

回复老师!
1.公式不要包括首行和首列
2.加判断语句,如果有内容区域的右下角单元格="合计",退出代码

mxg825

Sub MXG()



Dim R%, C%



R = UsedRange.Rows.Count '有内容区域最大【行】号

C = UsedRange.Columns.Count '有内容区域最大【列】号

if Cells(R + 1, C + 1) = "合计" then exit sub'新增这一句

Cells(R + 1, C + 1) = "合计"



Cells(2, C + 1).FormulaR1C1 = "=SUM(RC[-" & C - 1 & "]:RC[-1])" '填入公式SUM(B2:H2)

Range(Cells(2, C + 1), Cells(R, C + 1)).FillDown '下拉填充公式



Cells(R + 1, 2).FormulaR1C1 = "=SUM(R[-" & R - 1 & "]C:R[-1]C)" '填入公式SUM(B2:B33)

Range(Cells(R + 1, 2), Cells(R + 1, C)).FillRight '右拉填充公式



End Sub

hcy1185

mxg825 发表于 2012-4-3 22:11
Sub MXG()

老师您好!
我修改了一下代码,黄色单元格没有填完公式,请老师帮助,按现在的思路完善代码
在右下角合计.rar (15.58 KB, 下载次数: 7)

2012-4-3 23:02 上传

点击文件名下载附件

hcy1185

mxg825 发表于 2012-4-5 09:53

回复老师!
问题已经解决
有内容区域四角汇总.rar (20.49 KB, 下载次数: 12)

2012-4-5 11:21 上传

点击文件名下载附件 {:1112:}有需要的请下载

mxg825

1. 
   
2. Sub 区域汇总()
   
3. Dim rng As Range
   
4. Dim R%, C%
   
5. With ActiveSheet
   
6.    R = .UsedRange.Rows.Count    '有内容区域最大【行】号
   
7.    C = .UsedRange.Columns.Count '有内容区域最大【列】号
   
8.    On Error Resume Next
   
9.    Set rng = .UsedRange.SpecialCells(xlCellTypeLastCell).Offset(1, 1)
   
10.    If rng.Offset(-1, -1).Value = "合计" Then MsgBox "已填公式": Exit Sub
    
11.       rng = "合计"
    
12.       rng.Offset(1 - R, 0).FormulaR1C1 = "=SUM(RC[-" & C - 1 & "]:RC[-1])" '填入公式SUM(B2:H2)
    
13.          .Range(rng.Offset(1 - R, 0), rng.Offset(-1, 0)).FillDown '下拉填充公式
    
14. 
    
15.       rng.Offset(0, 1 - C).FormulaR1C1 = "=SUM(R[-" & R - 1 & "]C:R[-1]C)" '填入公式SUM(B2:B33)
    
16.          .Range(rng.Offset(0, 1 - C), rng.Offset(0, -1)).FillRight '右拉填充公式
    
17. End With
    
18. End Sub

复制代码

javabang