行和列具体数量不固定，对每行求和，填写到最后一列中；对每列求和，填写到最后一行

皮皮坦克

求解.rar (6.94 KB, 下载次数: 21)

2018-6-11 13:05 上传

点击文件名下载附件

皮皮坦克

只会对一列求和，多列循环就不会了，求帮助
Sub 列求和()
Dim rowcount As Byte
Dim acount As Integer
Dim I As Byte

rowcount = [a10000].End(xlUp).row

    For I = 1 To rowcount
    acount = acount + Range("A" & I).Value
    Next
Range("A" & (rowcount + 1)).Value = acount
End Sub

一把小刀闯天下

'黄色底色的横竖行、列清除掉数据

Option Explicit

Sub 求和()
  Dim arr, i, j
  arr = [a1].CurrentRegion
  arr = [a1].Resize(UBound(arr, 1) + 1, UBound(arr, 2) + 1)
  For j = 2 To UBound(arr, 2) - 1
    For i = 2 To UBound(arr, 1) - 1
      arr(UBound(arr, 1), j) = arr(UBound(arr, 1), j) + arr(i, j)
      arr(i, UBound(arr, 2)) = arr(i, UBound(arr, 2)) + arr(i, j)
  Next i, j
  arr(UBound(arr, 1), 1) = "合计": arr(1, UBound(arr, 2)) = "合计"
  [a1].Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End Sub

lsdongjh

1. 
   
2. Sub mySum()
   
3.     Dim lngRows As Long, lngCols As Long
   
4.     Dim lngR As Long, lngC As Long
   
5.     Dim arr As Variant
   
6.    
   
7.     lngRows = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
   
8.     lngCols = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column
   
9.    
   
10.     arr = Sheet1.Range(Cells(2, 2), Cells(lngRows, lngCols))
    
11.    
    
12.     For lngR = 1 To UBound(arr) - 1
    
13.         arr(lngR, UBound(arr, 2)) = 0
    
14.         arr(lngR, UBound(arr, 2)) = Application.WorksheetFunction.Sum(Application.WorksheetFunction.Index(arr, lngR, 0))
    
15.     Next
    
16.    
    
17.     For lngC = 1 To UBound(arr, 2)
    
18.         arr(UBound(arr), lngC) = 0
    
19.         arr(UBound(arr), lngC) = Application.WorksheetFunction.Sum(Application.WorksheetFunction.Index(arr, 0, lngC))
    
20.     Next
    
21.    
    
22.     Sheet1.Range("B2").Resize(UBound(arr), UBound(arr, 2)) = arr
    
23. End Sub
    

复制代码

皮皮坦克

一把小刀闯天下 发表于 2018-6-11 13:29
'黄色底色的横竖行、列清除掉数据

Option Explicit

VBA小白，刚学完EXCEL基础知识，这个读起来相当艰难了，能不能再麻烦写一下注释，谢谢你！
我把我看懂的写出来，不知道对不对，尴尬！
arr 代表数组，[a1]的CurrentRegion属性是一个区域，赋值给arr数组，
resize是一个扩展单元格区域的函数，UBound() 是获取数组最大索引数，第一个参数是数组名，第二个是数组的维，这里1和2分别代表行和列，arr = [a1].Resize(UBound(arr, 1) + 1, UBound(arr, 2) + 1)和是扩大一行一列的意思吗？
再下面是for  next 语句，之前学的就只有一个FOR的情况，这个同时i和j就看不懂了，语句中间的循环体语句就完全看不懂了，
再下面是合计这个赋值
再下面这个应该也是赋值吧，但是为什么这么赋值呢？  [a1].Resize(UBound(arr, 1), UBound(arr, 2)) = arr

皮皮坦克

lsdongjh 发表于 2018-6-11 14:00

谢谢你，能麻烦说一下都需要了解哪些知识点才能看懂这个过程吗？

皮皮坦克

一把小刀闯天下 发表于 2018-6-11 13:29
'黄色底色的横竖行、列清除掉数据

Option Explicit

如果再进一步，删除合计是0的行和列，怎么写！谢谢你！

jjmysjg

对各列行有合计的求和

lsdongjh

皮皮坦克 发表于 2018-6-11 16:30
谢谢你，能麻烦说一下都需要了解哪些知识点才能看懂这个过程吗？

一把小刀闯天下

皮皮坦克 发表于 2018-6-11 16:47
如果再进一步，删除合计是0的行和列，怎么写！谢谢你！

'稍作注释

Option Explicit

Sub 求和()
  Dim arr, i, j, a, b
  arr = [a1].CurrentRegion
  arr = [a1].Resize(UBound(arr, 1) + 1, UBound(arr, 2) + 1) '增加行、列各1，需要写入行、列和值
  For j = 2 To UBound(arr, 2) - 1 '头尾列不作处理
    For i = 2 To UBound(arr, 1) - 1 '头尾行不作处理
      arr(UBound(arr, 1), j) = arr(UBound(arr, 1), j) + arr(i, j) '列求和
      arr(i, UBound(arr, 2)) = arr(i, UBound(arr, 2)) + arr(i, j) '行求和
  Next i, j
  a = 1: b = 1: arr(UBound(arr, 1), UBound(arr, 2)) = 1 '标志为非0,写代码简单一点，无它用
  For i = 2 To UBound(arr, 1) '去除不满足条件的行
    If arr(i, UBound(arr, 2)) <> 0 Then
      a = a + 1
      For j = 1 To UBound(arr, 2): arr(a, j) = arr(i, j): Next
    End If
  Next
  For j = 2 To UBound(arr, 2) '去除不满足条件的列
    If arr(UBound(arr, 1), j) <> 0 Then
      b = b + 1
      For i = 1 To UBound(arr, 1): arr(i, b) = arr(i, j): Next
    End If
  Next
  arr(a, 1) = "合计": arr(1, b) = "合计": arr(a, b) = vbNullString '去除标志
  [a1].Resize(a, b) = arr
End Sub