ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 Office知识技巧免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 222|回复: 8

[求助] VBA跨表提取数据并取唯一值会进行汇总

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-1-29 16:46 | 显示全部楼层 |阅读模式
问题如上图片描述,谢谢大师们
捕获.PNG

蓝泰学校-学员登记库存.zip

34.78 KB, 下载次数: 12

TA的精华主题

TA的得分主题

发表于 2020-1-29 17:01 | 显示全部楼层
去重求和,可以考虑使用字典的
楼主的号码去重,那么其他两项是不是跟号码也是唯一对应》?

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-29 17:12 | 显示全部楼层
liulang0808 发表于 2020-1-29 17:01
去重求和,可以考虑使用字典的
楼主的号码去重,那么其他两项是不是跟号码也是唯一对应》?

是的老师,举个栗子,如果有几十或几百个学生,但是老板的号码都一样,那么就根据老板的电话来累计这些学生的学费进行汇总,前提是在报名登记里要有“返学费“,不知道我有没有表述清除

TA的精华主题

TA的得分主题

发表于 2020-1-29 17:30 | 显示全部楼层
Sub 按钮1_Click()
    Set d = CreateObject("scripting.dictionary")
    Application.ScreenUpdating = False
    arr = Sheets("报名登记").UsedRange
    r = 0
    For j = 7 To UBound(arr)
        If arr(j, 12) = "返学费" Then
            If d.exists(arr(j, 9) & "") Then
                x = d(arr(j, 9) & "")
                arr(x, 4) = arr(x, 4) + arr(j, 11)
            Else
                r = r + 1
                d(arr(j, 9) & "") = r
                arr(r, 1) = arr(j, 6)
                arr(r, 2) = arr(j, 5)
                arr(r, 3) = arr(j, 9)
                arr(r, 4) = arr(j, 11)
            End If
        End If
    Next j
    If r > 0 Then [k3].Resize(r, 4) = arr
    Application.ScreenUpdating = True
End Sub

TA的精华主题

TA的得分主题

发表于 2020-1-29 17:31 | 显示全部楼层
附件内容供参考。。。。。

蓝泰学校-学员登记库存.zip

35.68 KB, 下载次数: 8

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-29 17:46 | 显示全部楼层
liulang0808 发表于 2020-1-29 17:31
附件内容供参考。。。。。

老师可以不用按钮实现效果吗,能实时更新会更好,还有左边那个是明细,代码怎么写呢,求教老师,谢谢

TA的精华主题

TA的得分主题

发表于 2020-1-29 18:27 | 显示全部楼层

  1. Private Sub Worksheet_Activate()
  2.     Set d = CreateObject("scripting.dictionary")
  3.     Application.ScreenUpdating = False
  4.     arr = Sheets("报名登记").UsedRange
  5.     brr = Sheets("报名登记").UsedRange
  6.     r = 0
  7.     br = 0
  8.     For j = 7 To UBound(arr)
  9.         If arr(j, 12) = "返学费" Then
  10.             br = br + 1
  11.             brr(br, 1) = Format(arr(j, 1), "yyyy/mm/dd")
  12.             brr(br, 2) = arr(j, 9)
  13.             brr(br, 3) = arr(j, 3)
  14.             brr(br, 4) = arr(j, 4)
  15.             brr(br, 5) = arr(j, 2)
  16.             brr(br, 6) = arr(j, 5)
  17.             brr(br, 7) = arr(j, 6)
  18.             brr(br, 8) = arr(j, 10)
  19.             brr(br, 9) = arr(j, 11)

  20.             
  21.             If d.exists(arr(j, 9) & "") Then
  22.                 x = d(arr(j, 9) & "")
  23.                 arr(x, 4) = arr(x, 4) + arr(j, 11)
  24.             Else
  25.                 r = r + 1
  26.                 d(arr(j, 9) & "") = r
  27.                 arr(r, 1) = arr(j, 6)
  28.                 arr(r, 2) = arr(j, 5)
  29.                 arr(r, 3) = arr(j, 9)
  30.                 arr(r, 4) = arr(j, 11)
  31.             End If
  32.         End If
  33.     Next j
  34.     ActiveSheet.UsedRange.Offset(2).ClearContents
  35.     If r > 0 Then
  36.         [k3].Resize(r, 4) = arr
  37.         [a3].Resize(br, 9) = brr
  38.     End If
  39.     Application.ScreenUpdating = True
  40. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2020-1-29 18:28 | 显示全部楼层
表格事件,供参考。。。。。。

蓝泰学校-学员登记库存.zip

37.38 KB, 下载次数: 31

评分

参与人数 1鲜花 +2 收起 理由
深秋红叶2019 + 2 太强大了

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-29 18:59 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

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

GMT+8, 2020-4-5 15:42 , Processed in 0.084646 second(s), 18 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

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

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

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