查看: 964|回复: 12
用VBA实现条件求和
阅读权限20
在线时间 小时
本帖最后由 高峰3424 于
09:36 编辑
要求用VBA计算多个工程H列等于&自购&的行所对应的G列的值的和
09:36 上传
点击文件名下载附件
135.95 KB, 下载次数: 16
阅读权限95
在线时间 小时
论坛里这么多案例，多少都能抄个啦
阅读权限30
在线时间 小时
sumif不就搞掂了
阅读权限10
在线时间 小时
& & & & & & & &
效果如附件,这是固定数据源的vab，无法随表格更换而变动
22:24 上传
点击文件名下载附件
89.76 KB, 下载次数: 18
阅读权限10
在线时间 小时
效果如附件
22:26 上传
点击文件名下载附件
89.76 KB, 下载次数: 41
阅读权限10
在线时间 小时
上面的是固定的数据源版本，数据源不能增加行，如要改为随数据源变动的vba
将for i 那句代码，改为下面这句
For i = 7 To Range(&a65536&).End(xlUp).Row
阅读权限20
在线时间 小时
上面的是固定的数据源版本，数据源不能增加行，如要改为随数据源变动的vba
将for i 那句代码，改为下面这 ...
如果我是多个工程提取怎么改呢
阅读权限10
在线时间 小时
如果我是多个工程提取怎么改呢
具体什么要求，给个例子看下
阅读权限20
在线时间 小时
具体什么要求，给个例子看下
重新上传了附件，帮忙看看，谢谢
阅读权限10
在线时间 小时
本帖最后由 jjlovedj1314 于
20:14 编辑
这个需要在我的电脑D盘中新建一个data文件夹将3个文件都解压，打开自购表，另外两个表不需要打开，会自动求和到自购表，工程表用123做后缀把，一二三比较麻烦，也是懒，有什么问题再交流，只要你的表结构不做大改动，一般只需要改路径和统计表的次数就可以了，我在vba都有解释，自己慢慢琢磨把，也许你还能把这个vba做的更好，顺便说一句自购表只需要表头，名称和求和都可以自动统计。有完善的地方也可以提出来，我改进，也是刚学vba。嘻嘻勿喷
ps：做了调整，见12楼
19:42 上传
点击文件名下载附件
145.67 KB, 下载次数: 22
最新热点 /1
本活动是由微软（中国）有限公司发起，申请通过者可以得到Office 365企业级E3 试用账号，并享有全套Office 365客户端及云端高效、协作办公体验。 机会有限，先到先得！
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师查看: 1002|回复: 2
如果用VBA自动分类汇总
阅读权限10
在线时间 小时
求助大神如何利用VBA将附件里“汇总”表中的数据按F列项目进行分类合计后自动汇总到“成果表”中，成果表中已有的两个项目是自己手动做的，因为项目太多，求代码学习，感谢！
20:16 上传
点击文件名下载附件
14 KB, 下载次数: 27
阅读权限10
在线时间 小时
本帖最后由 菜头2014 于
21:52 编辑
希望能帮助到你，新手制作，供参考
21:52 上传
点击文件名下载附件
25.94 KB, 下载次数: 148
阅读权限10
在线时间 小时
希望能帮助到你，新手制作，供参考
非常感谢，学习中
最新热点 /1
本活动是由微软（中国）有限公司发起，申请通过者可以得到Office 365企业级E3 试用账号，并享有全套Office 365客户端及云端高效、协作办公体验。 机会有限，先到先得！
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师查看: 742|回复: 7
大神：用VBA分类，并求和，该怎么做？
阅读权限10
在线时间 小时
各位大神：上面这种文件，分类求和，用VBA改如何编写。求大神解答。感谢。。。
16:04 上传
点击文件名下载附件
4.1 KB, 下载次数: 8
阅读权限95
在线时间 小时
简单字典应用请参考:Sub Macro1()
& & Dim d As Object, arr, i&, j&, m&, r
& & Set d = CreateObject(&scripting.dictionary&)
& & arr = Range(&A1&).CurrentRegion
& & For i = 2 To UBound(arr)
& && &&&r = d(arr(i, 1) & arr(i, 2))
& && &&&If r = && Then
& && && && &m = m + 1
& && && && &d(arr(i, 1) & arr(i, 2)) = m
& && && && &For j = 1 To 3
& && && && && & arr(m, j) = arr(i, j)
& && && && &Next
& && &&&Else
& && && && &arr(r, 3) = arr(r, 3) + arr(i, 3)
& && &&&End If
& & Next
& & With Sheets(&Sheet2&)
& && &&&.[a1].CurrentRegion.Offset(1).ClearContents
& && &&&.[a2].Resize(m, 3) = arr
& && &&&.Activate
& & End With
End Sub
复制代码
阅读权限95
在线时间 小时
请测试附件
(10.42 KB, 下载次数: 18)
16:20 上传
点击文件名下载附件
阅读权限10
在线时间 小时
zhaogang1960 发表于
请测试附件
请问如果有1000组收据，该如何修改程序
阅读权限95
在线时间 小时
xueguoru 发表于
请问如果有1000组收据，该如何修改程序
1000组收据何意？
请模拟效果说明
阅读权限10
在线时间 小时
& & & & & & & &
zhaogang1960 发表于
1000组收据何意？
请模拟效果说明
像这种组数多的，改修改哪些变量？
16:39 上传
点击文件名下载附件
8.33 KB, 下载次数: 12
阅读权限95
在线时间 小时
xueguoru 发表于
像这种组数多的，改修改哪些变量？
这个和一楼有什么区别？
如果有区别，请告诉我你想得到什么结果
阅读权限10
在线时间 小时
zhaogang1960 发表于
这个和一楼有什么区别？
如果有区别，请告诉我你想得到什么结果
非常感谢，大神，不好意思，刚才可能输错了，现在可以运行了
最新热点 /1
本活动是由微软（中国）有限公司发起，申请通过者可以得到Office 365企业级E3 试用账号，并享有全套Office 365客户端及云端高效、协作办公体验。 机会有限，先到先得！
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师EXCEL&VBA&小计合计自动计算可达到分类汇总的效果
假设表格名为 "汇总"
和"小计汇总"，此表格为51列，您可根据需要修改
Private Sub 小计合计计算2012()
i&, j%, n&
Dim heji(5 To 51) As Double
Application.ScreenUpdating = False
Sheets("小计汇总").Cells.Borders.LineStyle = 0
xlSingle---虚线& xlDouble--
Sheets("汇总").Select
r = Sheets("汇总").UsedRange.Rows.Count
'把表格Sheet1中用户已经使用过的行数赋给常量n
Debug.Print r
& For i = 5 To r - 1
Debug.Print i&&&&&&''''''下面&
则为所在列的左边1列、以此类推，列公式可以据此编辑&&&&&
Cells(i, 26).FormulaR1C1 = "=SUM(RC[-20]:RC[-14])
SUM(RC[-12]:RC[-4])-RC[-3]-RC[-2]-RC[-1]"
Cells(i, 36).FormulaR1C1 = "=SUM(RC[-9]:RC[-1])"
Cells(i, 37).FormulaR1C1 = "=RC[-11] - RC[-1]"
Cells(i, 49).FormulaR1C1 = "=SUM(RC[-11]:RC[-1])"
Cells(i, 50).FormulaR1C1 = "=ROUND(RC[-24] RC[-1],2)"
Cells(i, 51).FormulaR1C1 = "=ROUND(RC[-14] RC[-2],2)"
& ''''''''''计算小计
n = 4 '''''''''''''''''''''''为姓名所在行12-22
& For i = 5 To r - 1
&& If Cells(i, 1) = "小计"
m = Cells(i, 1).Row
Debug.Print m, n '''17
For j = 5 To 52
&&&&&&&&&&&&&&
Debug.Print "=SUBTOTAL(9,R[-" & m - n - 1
& "]C:R[-1]C)"
&&&&&&&&&&&&&&
Cells(i, j).FormulaR1C1 = "=SUBTOTAL(9,R[-" & m - n
- 1 & "]C:R[-1]C)"
&&& End If
''''''''''计算小计
Sheets("汇总").UsedRange.Rows.Count
'把表格Sheet1中用户已经使用过的行数赋给常量n
''''''''''计算合计12-22
For j = 5 To 52
&&&&&&&&&&&&
Cells(r, j).FormulaR1C1 = "=SUBTOTAL(9,R[-" & r - 3
& "]C:R[-1]C)"
& ''''''''''计算合计
Debug.Print "小计合计计算完毕！"
r = Sheets("汇总").UsedRange.Rows.Count
'把表格Sheet1中用户已经使用过的行数赋给常量n
Sheets("汇总").UsedRange.Rows(r).NumberFormatLocal = "0.00_
''''''汇总表至小计汇总表
& For i = 5 To r - 1
& Debug.Print i
Sheets("汇总").Cells(i, 1) = "小计" Then
&&&&&&&&&&
Sheets("小计汇总").Rows(n).Value = Sheets("汇总").Rows(i).Value
'将一个表中的一行全部拷贝到另一个表中
&&&&&&&&&&&&
& Sheets("小计汇总").Rows(n).Value =
Sheets("汇总").Rows(r).Value '将一个表中的一行全部拷贝到另一个表中
For i = 5 To n - 1 '''序号
Sheets("小计汇总").Cells(i, 1) = i - 4
''''''汇总表至小计汇总表
Sheets("小计汇总").Range("A3").Resize(n - 2, 52).Borders.LineStyle = 1
xlSingle---虚线& xlDouble---双线
MsgBox "小计合计计算完毕！"
Application.ScreenUpdating = True
念佛一声&&
礼佛一拜&&
敬请常念：
南无阿弥陀佛&&&&&&&&
南无阿弥陀佛&&&&&&&&
南无阿弥陀佛
南无观世音菩萨&&&&&&
南无观世音菩萨&&&&&&
南无观世音菩萨
南无大愿地藏王菩萨&&
南无大愿地藏王菩萨&&
南无大愿地藏王菩萨
已投稿到：
以上网友发言只代表其个人观点，不代表新浪网的观点或立场。(window.slotbydup=window.slotbydup || []).push({
id: '3284507',
container: s,
size: '0,0',
display: 'inlay-fix'
excel VBA对多个工作簿进行合并计算（求和）实例教程
Excel中的合并计算可以对多个工作表的对应项目进行求和、求平均值等计算，但如果需要合并计算的工作表较多，特别是这些工作表位于不同的工作簿内时，逐一选择数据源显得较为繁琐。用VBA中的Range.Consolidate方法可以快速地对多个结构相似的工作表进行合并计算，但如果表格内包含有非数值类型的数据列，合并计算会忽略这些列。例如下图为某个图书销售点1至12月的图书销售记录，销售数量位于D至O列，其中B列和C列为与A列对应的数据，无需参与合并计算，但必须在汇总表中列出。各销售点都有一个类似的销售表格，每个分表列出的图书数量不等，图书名称也不尽相同。现在需要对各销售点的销售表格中D至O列的销售数量按照A列图书名称进行合计，求出总的销售数量。
如果直接使用合并计算，Excel会忽略B列文本，同时对C列（单价）也进行合并计算，显然不符合要求。这时使用VBA中的Dictionary对象，可以解决这一问题，代码如下：
Sub SumWorkbooks()
Dim ThePath As String, TheFile As String
Dim d As Object, Wbk As Workbook
Dim i As Integer, j As Integer, k As Integer
Dim Arr1(11), Arr2(), Arr3(), dk
On Error Resume Next
Application.ScreenUpdating = False
Set d = CreateObject(&scripting.dictionary&)
ThePath = ThisWorkbook.Path & &\&
TheFile = Dir(ThePath & &*.xls&)
Do While TheFile && &&
If TheFile && ThisWorkbook.Name Then
Set Wbk = GetObject(ThePath & TheFile)
With Wbk.Worksheets(1)
For i = 2 To .Range(&A65536&).End(xlUp).Row
'将D至O列数值赋值给Arr1
For j = 0 To 11
Arr1(j) = .Cells(i, j + 4).Value
If Not d.exists(.Range(&A& & i).Value) Then
'key对应一个数组
d.Add .Range(&A& & i).Value, Arr1
'将不能求和的数据赋值给Arr2
ReDim Preserve Arr2(1 To 2, 1 To k + 1)
For j = 1 To 2
Arr2(j, k + 1) = .Cells(i, j + 1)
For j = 0 To 11
'若数据存在则D至O列数值对应合计到Arr1中的每个元素
Arr1(j) = d(.Range(&A& & i).Value)(j) + Arr1(j)
d(.Range(&A& & i).Value) = Arr1
Wbk.Close False
TheFile = Dir '当前文件夹内的下一个工作簿
With ThisWorkbook.Worksheets(1)
.Range(&A2&).Resize(d.Count, 1) = Application.Transpose(d.keys)
dk = d.keys
ReDim Arr3(1 To d.Count, 1 To 12)
For i = 0 To d.Count - 1
For j = 0 To 11
Arr3(i + 1, j + 1) = d(dk(i))(j)
.Range(&D2:O& & d.Count + 1).Value = Arr3
.Range(&B2:C& & d.Count + 1).Value = Application.Transpose(Arr2)
Set d = Nothing
Application.ScreenUpdating = True
在汇总表中按Alt+F11，打开VBA编辑器，单击&插入&模块&，粘贴上述代码并运行，即可对汇总工作簿所在的文件夹内的其他所有工作簿的第一个工作表进行合并求和，无需打开各个需要汇总的工作簿。汇总后的B、C两列为与A列对应的数据。汇总前须注意以下几点：
1.将汇总工作簿和其他各个工作簿放到同一文件夹内，并保存汇总工作簿。汇总前移走文件夹内所有无关工作簿。
2.各分表应位于各工作簿中的最左侧（第一个）。
3.各分表内的记录数量可以不同，但行标题需相同。
标签(Tag):
------分隔线----------------------------
------分隔线----------------------------
猜你感兴趣}