ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

   
高效办公必会的Office实战技巧 永久免费,网表让Excel秒变数据库 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel函数公式学习大典 第2届Power BI可视化大赛,拿超级大奖! 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 打造核心竞争力的职场宝典 13门Excel免费公开课任你学
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 238|回复: 11

[求助] 一个简单的汇总,但是论坛没找到类似的帖子,求助

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-9-14 10:40 | 显示全部楼层 |阅读模式
本帖最后由 zaiciyun 于 2018-9-14 10:42 编辑

权属名称地类编码面积
张家沟01150
张家沟01320
张家沟20130
张家沟01180
李家村20240
李家村01160
李家村20370
想将上面的表格汇总成下面的格式
权属名称
011
013
201
202
203
张家沟
130.00
20.00
30.00
0.00
0.00
李家村
60.00
0.00
0.00
40.00
70.00


这个数据只是一部分,市级的分类和权属会很多,请哪位大神有时间帮忙看看怎么vba实现,透视表得到的结果,用起来很不方便,万分感谢。。

数据.rar (4.41 KB, 下载次数: 17)

TA的精华主题

TA的得分主题

发表于 2018-9-14 10:53 来自手机 | 显示全部楼层
一个字典匹配求和问题呀

TA的精华主题

TA的得分主题

发表于 2018-9-14 11:02 | 显示全部楼层
'假设A列有序

Option Explicit

Sub test()
  Dim arr, i, dic, n
  Set dic = CreateObject("scripting.dictionary")
  arr = [a1].CurrentRegion.Offset(1).Value
  For i = 1 To UBound(arr, 1) - 1
    If Not dic.exists(arr(i, 2)) Then n = n + 1: dic(arr(i, 2)) = n + 1
  Next
  ReDim brr(1 To UBound(arr, 1), 1 To dic.Count + 1)
  n = 1
  For i = 1 To UBound(arr, 1) - 1
    brr(n, (dic(arr(i, 2)))) = brr(n, (dic(arr(i, 2)))) + arr(i, 3)
    If arr(i, 1) <> arr(i + 1, 1) Then brr(n, 1) = arr(i, 1): n = n + 1
  Next
  With [e2]
    .Offset(-1, 1).Resize(, dic.Count) = dic.keys
    .Resize(Rows.Count - 1, UBound(brr, 2)).ClearContents
    If n > 0 Then .Resize(n - 1, UBound(brr, 2)) = brr
  End With
End Sub

评分

参与人数 1鲜花 +3 收起 理由
sayhi95 + 3 感谢帮助

查看全部评分

TA的精华主题

TA的得分主题

发表于 2018-9-14 11:08 | 显示全部楼层
  1. Sub 统计()
  2.     Set cnn = CreateObject("adodb.connection")
  3.     Set rst = CreateObject("adodb.recordset")
  4.     cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0;data source=" & ThisWorkbook.FullName
  5.     Sql = "Transform sum(面积) select 权属名称 from [原始表$] group by 权属名称 pivot(地类编码)"
  6.     rst.Open Sql, cnn, 1, 3
  7.     With Sheets("成果表")
  8.         Set xrng = .[a1]
  9.         For i = 0 To rst.Fields.Count - 1
  10.             xrng.Offset(, i) = rst.Fields(i).Name
  11.         Next
  12.         xrng.Offset(1).CopyFromRecordset rst
  13.         .Activate
  14.     End With
  15.     rst.Close: Set rst = Nothing
  16.     cnn.Close: Set cnn = Nothing
  17. End Sub
复制代码

数据.rar

10.92 KB, 下载次数: 9

评分

参与人数 3鲜花 +7 收起 理由
km122712 + 2 感谢帮助
sayhi95 + 3 感谢帮助
高飞扬 + 2 优秀作品

查看全部评分

TA的精华主题

TA的得分主题

发表于 2018-9-14 11:44 | 显示全部楼层
看看这个是否符合,好了送花

数据.zip

14.27 KB, 下载次数: 7

评分

参与人数 1鲜花 +2 收起 理由
zaiciyun + 2 优秀作品

查看全部评分

TA的精华主题

TA的得分主题

发表于 2018-9-14 11:57 | 显示全部楼层
Sub TT()
Application.DisplayAlerts = False
Set cn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
cn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source= " & ThisWorkbook.FullName
Sql = "SELECT * FROM [原始表$a1:c]"
Set rs.ActiveConnection = cn
rs.Open Sql
Set pvc = ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)
Set pvc.Recordset = rs
Set pvt = ActiveSheet.PivotTables.Add(PivotCache:=pvc, TableDestination:=Range("A10"))
With pvt
.SmallGrid = False
.AddFields RowFields:="权属名称", ColumnFields:="地类编码"
.AddDataField .PivotFields("面积"), "面积求和", xlSum
End With
Cells.Copy
[A1].PasteSpecial Paste:=xlPasteValues
Rows(10).Delete
End Sub

评分

参与人数 2鲜花 +5 收起 理由
km122712 + 2 感谢帮助
sayhi95 + 3 优秀作品

查看全部评分

TA的精华主题

TA的得分主题

发表于 2018-9-14 11:58 | 显示全部楼层
对于我来说它就是简单,核心代码就一句:
transform sum(面积) select 权属名称 from [原始表$] group by 权属名称 pivot 地类编码
但是对于你来说,你不会,就不要说简单不简单了
1.png

评分

参与人数 2鲜花 +5 收起 理由
km122712 + 2 感谢帮助
sayhi95 + 3 优秀作品

查看全部评分

TA的精华主题

TA的得分主题

发表于 2018-9-14 11:58 | 显示全部楼层
附件***********

数据.rar

16.88 KB, 下载次数: 7

TA的精华主题

TA的得分主题

发表于 2018-9-14 15:23 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-9-14 16:47 | 显示全部楼层
我是来讨说法的 发表于 2018-9-14 11:58
对于我来说它就是简单,核心代码就一句:
transform sum(面积) select 权属名称 from [原始表$] group by  ...

我所说的简单 肯定是对于你们这些大神说的
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,每天学会一个新技能

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2018-9-25 06:58 , Processed in 0.080223 second(s), 18 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 2001-2017 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表