ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

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

[求助] VBA去重汇总并去除值为零的项

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-9-7 16:05 | 显示全部楼层 |阅读模式
本帖最后由 wagess 于 2019-9-7 16:58 编辑

因数据有几千条且后续还要不断增加,请用VBA去重汇总并去除值为零的项
Sub aaaaa()
   Dim dic As Object, ii&, arr
    ii = Sheets("Sheet1").Range("a65536").End(xlUp).Row

    Set dic = CreateObject("Scripting.Dictionary")
    arr = Sheets("Sheet1").Range("a2:c" & ii)
    For ii = 1 To UBound(arr)
        'dic(arr(ii, 1)) = ii
       If arr(ii, 2) = "卖出" Then dic(arr(ii, 1)) = dic(arr(ii, 1)) - arr(ii, 3) Else dic(arr(ii, 1)) = dic(arr(ii, 1)) + arr(ii, 3)
    Next
    For Each k In dic.items
       If k = 0 Then dic.Remove (k)
   Next


    'For ii = 1 To dic.Count - 1
    '  If dic(arr(ii, 1)).items = 0 Then dic.Remove arr(ii, 1).Value   ' dic(arr(ii, 1)) = dic(arr(ii, 1)).Remove("dic(arr(ii, 1))")
   ' Next
    Sheets("Sheet1").Range("k2:l10").ClearContents
    Sheets("Sheet1").Range("k2").Resize(dic.Count) = WorksheetFunction.Transpose(dic.keys)
    Sheets("Sheet1").Range("l2").Resize(dic.Count) = WorksheetFunction.Transpose(dic.items)

End Sub
就卡在这里了
    For Each k In dic.items
       If k = 0 Then dic.Remove (k)
   Next




求助.rar

6.05 KB, 下载次数: 16

TA的精华主题

TA的得分主题

发表于 2019-9-7 16:11 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-9-7 16:29 | 显示全部楼层
字典,循环,就可以完成,论坛上的例子太多了,
我都不想写了,,,

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-9-7 16:35 | 显示全部楼层
本帖最后由 wagess 于 2019-9-7 16:41 编辑

问题出在根据ITEMS值删除对应字典KEYS项上,论坛上找了很久没找到解决方法

TA的精华主题

TA的得分主题

发表于 2019-9-7 16:56 | 显示全部楼层
wagess 发表于 2019-9-7 16:35
问题出在根据ITEMS值删除对应字典KEYS项上,论坛上找了很久没找到解决方法

你可以换个思路,数组循环,重新赋值到新数组,就可以了,  

031.png

TA的精华主题

TA的得分主题

发表于 2019-9-7 16:58 | 显示全部楼层
习惯性动作,上传代码:

  1. Sub 字典循环汇总数据()
  2.     Dim d As Object, mRow As Long, arr, ZR(), i As Long, XR()
  3.     Dim m As Long: m = 0: Dim h As Long: h = 0
  4.     Set d = CreateObject("Scripting.Dictionary")
  5.     With Sheet1
  6.         .Activate
  7.         mRow = .Range("A1048576").End(3).Row
  8.         arr = .Range("A2:C" & mRow).Value
  9.         ReDim ZR(1 To UBound(arr), 1 To 2)
  10.         For i = 1 To UBound(arr)
  11.             If arr(i, 1) <> "" Then
  12.                 If InStr(arr(i, 2), "卖出") Then arr(i, 3) = Val(arr(i, 3)) * -1
  13.                 If d.Exists(arr(i, 1)) Then
  14.                     h = d(arr(i, 1))
  15.                     ZR(h, 2) = ZR(h, 2) + Val(arr(i, 3))
  16.                 Else
  17.                     m = m + 1
  18.                     d(arr(i, 1)) = m
  19.                     ZR(m, 1) = arr(i, 1)
  20.                     ZR(m, 2) = arr(i, 3)
  21.                 End If
  22.             End If
  23.         Next
  24.         ReDim XR(1 To UBound(ZR), 1 To 2)
  25.         m = 0
  26.         For i = 1 To UBound(ZR)
  27.             If Val(ZR(i, 2)) <> 0 Then
  28.                 m = m + 1
  29.                 XR(m, 1) = ZR(i, 1)
  30.                 XR(m, 2) = ZR(i, 2)
  31.             End If
  32.         Next
  33.         With .Range("H2")
  34.             .Resize(4 ^ 8, 2).ClearContents
  35.             .Resize(d.Count, 2).Value = XR
  36.         End With
  37.     End With
  38.     Set d = Nothing: Erase arr: Erase ZR: Erase XR
  39. End Sub
复制代码


TA的精华主题

TA的得分主题

发表于 2019-9-7 17:01 | 显示全部楼层
其他就不看了,就你卡住这一句,我来改一下试试。
  1.     For Each k In dic.items
  2.        If k = 0 Then dic.Remove (k)
  3.    Next
复制代码

改成:
  1.     For Each k In dic.keys
  2.        If dic(k) = 0 Then dic.Remove (k)
  3.     Next
复制代码

TA的精华主题

TA的得分主题

发表于 2019-9-7 17:05 | 显示全部楼层
python pandas写的
  1. import pandas as pd
  2. import numpy as np
  3. df=pd.read_excel('your_excel_file')                                                                                             

  4. def to_nag(x,y):
  5.     if x=='卖出':
  6.         return -y
  7.     else:
  8.         return y

  9. df['数量']=np.vectorize(to_nag)(df['摘要'],df['数量'])
  10. grouped=df.groupby('名称')['数量'].sum()
  11. result=grouped.reset_index()
  12. result=result[result['数量']!=0]
复制代码

结果:
Screenshot from 2019-09-07 16-56-58.png

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-9-7 17:08 | 显示全部楼层
本帖最后由 wagess 于 2019-9-7 17:25 编辑
opel-wong 发表于 2019-9-7 16:58
习惯性动作,上传代码:

可能我的EXCEL版本太低,运行出错:对象不支持该属性

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-9-7 17:11 | 显示全部楼层
大灰狼1976 发表于 2019-9-7 17:01
其他就不看了,就你卡住这一句,我来改一下试试。

改成:

谢谢,问题完美解决
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

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

GMT+8, 2020-1-25 06:57 , Processed in 0.356666 second(s), 17 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

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

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

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