ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 771|回复: 4

[求助] 求助,用vba看能不能实现汇总合并且去重计数

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-10-22 20:49 | 显示全部楼层 |阅读模式
1、根据表1中的数据汇总到表2每个咨询接待人员下的各平台的咨询类别的不重复个数。
表1中的数据咨询接待人员、平台、咨询类别会变动,因为数据过于庞大,直列举一小部分。
2、计数不重复个数条件:同平台同一个昵称同一咨询类别且同一咨询接待下(四个条件下),只能统计数一次

Book1.zip

11.56 KB, 下载次数: 7

TA的精华主题

TA的得分主题

发表于 2019-10-23 08:08 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
  1. Sub 按钮1_Click()
  2.     Set d = CreateObject("scripting.dictionary")
  3.     Set dd = CreateObject("scripting.dictionary")
  4.     Application.ScreenUpdating = False
  5.     Application.DisplayAlerts = False
  6.     ActiveSheet.UsedRange.Offset(2).Clear
  7.     arr = Sheets("1").UsedRange
  8.     For j = 2 To UBound(arr)
  9.         If Len(arr(j, 10)) > 0 Then
  10.             dd(arr(j, 3) & "###" & arr(j, 10)) = dd(arr(j, 3) & "###" & arr(j, 10)) + 1
  11.             str1 = arr(j, 3) & arr(j, 10) & arr(j, 4) & arr(j, 8)
  12.             If Not d.exists(str1 & arr(j, 5)) Then
  13.                 d(str1) = d(str1) + 1
  14.                 d(str1 & arr(j, 5)) = j
  15.             End If
  16.         End If
  17.     Next j
  18.     For j = 0 To dd.Count - 1
  19.         Cells(j + 3, 1).Resize(1, 2) = Split(dd.keys()(j), "###")
  20.     Next j
  21.     [a3].Resize(dd.Count, 2).Sort key1:=[a3], Order1:=xlAscending
  22.     arr = ActiveSheet.UsedRange
  23.     For j = 3 To UBound(arr)
  24.         sm = 0
  25.         str1 = arr(j, 1) & arr(j, 2)
  26.         For i = 3 To 7
  27.             If d.exists(str1 & "微信" & arr(2, i)) Then
  28.                 arr(j, i) = d(str1 & "微信" & arr(2, i))
  29.                 sm = sm + arr(j, i)
  30.             End If
  31.             arr(j, 13) = sm
  32.         Next i
  33.         sm = 0
  34.         For i = 8 To 12
  35.             If d.exists(str1 & "电话" & arr(2, i)) Then
  36.                 arr(j, i) = d(str1 & "电话" & arr(2, i))
  37.                 sm = sm + arr(j, i)
  38.             End If
  39.             arr(j, 14) = sm
  40.         Next i
  41.     Next j
  42.     ActiveSheet.UsedRange = arr
  43.     r = Cells(Rows.Count, 1).End(3).Row + 1
  44.     Cells(r, 1) = "合计"
  45.     For j = 3 To UBound(arr, 2)
  46.         Cells(r, j) = WorksheetFunction.Sum(Cells(3, j).Resize(r - 3))
  47.     Next j
  48.     arr = ActiveSheet.UsedRange
  49.     For i = UBound(arr) - 1 To 3 Step -1
  50.         If arr(i, 1) = arr(i + 1, 1) Then
  51.             Cells(i, 1).Resize(2).Merge
  52.             For j = 3 To UBound(arr, 2)
  53.                 Cells(r, j) = Cells(r, j) + Cells(i, j)
  54.             Next j
  55.         Else
  56.             r = i + 1
  57.             Rows(r).Insert
  58.             Cells(r, 1).Resize(1, 2).Merge
  59.             Cells(r, 1) = "合计"
  60.             For j = 3 To UBound(arr, 2)
  61.                 Cells(r, j) = Cells(r, j) + Cells(i, j)
  62.             Next j
  63.         End If
  64.     Next i
  65.     ActiveSheet.UsedRange.Borders.LineStyle = xlContinuous
  66.     Application.DisplayAlerts = True
  67.     Application.ScreenUpdating = True
  68. End Sub
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-10-23 08:09 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
楼主的id是新的,但是帖子内容最近有人发过吧?
附件楼主的模拟结果数据,与代码统计结果有出入,供参考。。。。

Book1.zip

23.46 KB, 下载次数: 6

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-10-25 13:14 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
liulang0808 发表于 2019-10-23 08:09
楼主的id是新的,但是帖子内容最近有人发过吧?
附件楼主的模拟结果数据,与代码统计结果有出入,供参考。 ...

你好,这个好像去重统计结果不一样,看不懂代码,不知道是不是那个错了,但是手动统计下个别平台下的不一样

TA的精华主题

TA的得分主题

发表于 2019-10-25 13:28 | 显示全部楼层
强大的vba 发表于 2019-10-25 13:14
你好,这个好像去重统计结果不一样,看不懂代码,不知道是不是那个错了,但是手动统计下个别平台下的不一 ...

用目前的数据,楼主模拟下真实的结果,再看看哪里有问题吧
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-28 18:24 , Processed in 0.038687 second(s), 14 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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