Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2517|回复: 5

各位大侠,能帮忙写一个删除重复项再排序的程序呗

[复制链接]
发表于 2019-7-2 16:18 | 显示全部楼层 |阅读模式
2学分
各路大侠神仙,帮忙写个删除重复项,再从大到小排序的程序呗 1562051964(2).png 1562051964(3).png

排序.rar

14.09 KB, 下载次数: 6

最佳答案

查看完整内容

上面代码漏掉了一行,没有对a列编号。本来打算重新编辑的,但发现编辑不上去,我就写在这里,你复制代码的时候加上: 在最后一个循环,也就是倒数第三行代码 Range(Cells(i + 2, 2), Cells(i + 2, 3)) = zd(arr2(i))的后面,加一行 Cells(i + 2, 1) = i + 1 这是对a列进行做顺序编码
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2019-7-2 16:18 | 显示全部楼层
上面代码漏掉了一行,没有对a列编号。本来打算重新编辑的,但发现编辑不上去,我就写在这里,你复制代码的时候加上:
在最后一个循环,也就是倒数第三行代码 Range(Cells(i + 2, 2), Cells(i + 2, 3)) = zd(arr2(i))的后面,加一行
    Cells(i + 2, 1) = i + 1
这是对a列进行做顺序编码
回复

使用道具 举报

发表于 2019-7-2 19:59 | 显示全部楼层
看看是否符合你的要求。




排序.zip (23.89 KB, 下载次数: 4)
回复

使用道具 举报

 楼主| 发表于 2019-7-2 21:08 | 显示全部楼层
本帖最后由 huangkepan 于 2019-7-2 21:12 编辑
cui26896 发表于 2019-7-2 19:59
看看是否符合你的要求。

不是我要的,我要的是在sheet3进行在原有表格进行重排,不是在sheet1,而且您现在也是依据我在sheet1上进行的不行的;我附件有错,我重新上传

排序.rar

14.08 KB, 下载次数: 9

回复

使用道具 举报

发表于 2019-7-3 10:54 | 显示全部楼层
本帖最后由 hfwufanhf2006 于 2019-7-3 11:03 编辑

1、数据透视其实也可以,还快;
2、如果一定要代码,把下面代码放在sheet3中,数据来源于sheet2,如果不是,请自行修改工作表名称
Dim zd As Object
Set zd = CreateObject("scripting.dictionary")
Dim arr
Dim arr1(1 To 2)
For i = 2 To Worksheets("sheet2").[b10000].End(3).Row
    s = Worksheets("sheet2").Cells(i, 2)
    If zd.exists(s) Then
       arr = zd(s)
       arr(2) = arr(2) + Worksheets("sheet2").Cells(i, 3)
       zd(s) = arr
    Else
       arr1(1) = s
       arr1(2) = Worksheets("sheet2").Cells(i, 3)
       zd(s) = arr1
    End If
Next i
Dim arr2
arr2 = zd.keys
For i = 0 To UBound(arr2)
    Range(Cells(i + 2, 2), Cells(i + 2, 3)) = zd(arr2(i))    Cells(i + 2, 1) = i + 1    Cells(i + 2, 1) = i + 1
Next i
Range("b1:c" & [c1000].End(3).Row).Sort key1:=Range("c1"), order1:=2, Header:=xlYes


回复

使用道具 举报

 楼主| 发表于 2019-7-3 12:42 | 显示全部楼层
hfwufanhf2006 发表于 2019-7-3 11:07
上面代码漏掉了一行,没有对a列编号。本来打算重新编辑的,但发现编辑不上去,我就写在这里,你复制代码的 ...

谢谢,非常棒,加了执行、和结束语句就可以了,谢谢
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-28 20:24 , Processed in 0.266796 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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