ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

新浪微博登陆

只需一步, 快速开始

   
高效办公必会的Office实战技巧 永久免费,网表让Excel秒变数据库 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! 国内首部Excel函数公式学习大典 职场充电黑科技, Office微视频教程 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 突破Excel限制,用活字格提高效率 12门Excel免费公开课任你学
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 146|回复: 16

[已解决] 单元格内容去重/排序

[复制链接]

TA的精华主题

TA的得分主题

发表于 2017-8-13 08:51 | 显示全部楼层 |阅读模式
本帖最后由 宝贝万岁 于 2017-8-14 21:44 编辑

单元格内容用逗号隔开,如何去重/排序??求教大神~,拜谢~

单元格内容取重并排序.rar

6.62 KB, 下载次数: 14

TA的精华主题

TA的得分主题

发表于 2017-8-13 09:08 | 显示全部楼层
split,字典去重,排序,要用到的知识点还不少…………

TA的精华主题

TA的得分主题

发表于 2017-8-13 09:11 | 显示全部楼层
结果写到D列了。。。
Sub 按钮1_Click()
Dim a, b()
a = Range("A2:A" & [a65536].End(3).Row)
ReDim b(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
Dim d
Set d = CreateObject("Scripting.Dictionary")
For j = 0 To UBound(Split(a(i, 1), ","))
If Not d.exists(Val(Split(a(i, 1), ",")(j))) Then d.Add Val(Split(a(i, 1), ",")(j)), ""
Next j
Dim c
c = d.Count
Do While c > 0
If b(i, 1) = "" Then
b(i, 1) = WorksheetFunction.Min(d.keys())
Else
b(i, 1) = b(i, 1) & "," & WorksheetFunction.Min(d.keys())
End If
d.Remove WorksheetFunction.Min(d.keys())
c = d.Count
Loop
Next i
[d2].Resize(UBound(b), 1) = b
End Sub

单元格内容取重并排序.7z

16.26 KB, 下载次数: 6

评分

参与人数 1鲜花 +2 收起 理由
宝贝万岁 + 2 感谢帮助

查看全部评分

TA的精华主题

TA的得分主题

发表于 2017-8-13 09:48 | 显示全部楼层
本帖最后由 jiminyanyan 于 2017-8-13 10:04 编辑

Sub jimin()
    Set x = CreateObject("msscriptcontrol.scriptcontrol")
    x.Language = "javascript"
    x.addcode "function aa(bb){x=bb.split(',');x.sort(function(a,b){return a- b});for(i = 0; i<x.length;i++){if(x==x[i+1]){x.splice(i, 1);i=i-1;}};return x;}"
    n = Sheet1.Range("a65535").End(xlUp).Row
    For i = 2 To n
        kk = Sheet1.Cells(i, 1)
        Sheet1.Cells(i, 2) = x.eval("aa('" & kk & "')")
    Next
End Sub

TA的精华主题

TA的得分主题

发表于 2017-8-13 09:54 | 显示全部楼层
jiminyanyan 发表于 2017-8-13 09:48
这个没有去重功能…………
Sub jimin()
    Set x = CreateObject("msscriptcontrol.scriptcontrol")

如果用字典,去重,排序都可以搞定。。。

TA的精华主题

TA的得分主题

发表于 2017-8-13 09:57 | 显示全部楼层
本帖最后由 jiminyanyan 于 2017-8-13 10:04 编辑
paciguard 发表于 2017-8-13 09:54
如果用字典,去重,排序都可以搞定。。。

实现是可以的……。
javascript的代码比较简洁Sub jimin()
    Set x = CreateObject("msscriptcontrol.scriptcontrol")
    x.Language = "javascript"
    x.addcode "function aa(bb){x=bb.split(',');x.sort(function(a,b){return a- b});for(i = 0; i<x.length;i++){if(x==x[i+1]){x.splice(i, 1);i=i-1;}};return x;}"
    n = Sheet1.Range("a65535").End(xlUp).Row
    For i = 2 To n
        kk = Sheet1.Cells(i, 1)
        Sheet1.Cells(i, 2) = x.eval("aa('" & kk & "')")
    Next
End Sub


评分

参与人数 1鲜花 +2 收起 理由
宝贝万岁 + 2 感谢帮助

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-8-13 10:59 | 显示全部楼层
jiminyanyan 发表于 2017-8-13 09:57
实现是可以的……。
javascript的代码比较简洁Sub jimin()
    Set x = CreateObject("msscriptcontrol ...

谢谢大神,没有去重功能,而且沃研究不懂这种代码。。。惭愧~

TA的精华主题

TA的得分主题

发表于 2017-8-13 11:02 | 显示全部楼层
宝贝万岁 发表于 2017-8-13 10:59
谢谢大神,没有去重功能,而且沃研究不懂这种代码。。。惭愧~
  1. Sub yy()
  2.   Dim d, arr, ar, i&, k&
  3.   Set d = CreateObject("Scripting.Dictionary")
  4.   arr = Range("A2", [a2].End(4)).Value
  5.   For k = 1 To UBound(arr)
  6.     ar = Split(arr(k, 1), ",")
  7.     ReDim br(0 To UBound(ar))
  8.     For i = 0 To UBound(ar)
  9.       br(i) = Int(ar(i))
  10.     Next
  11.     For i = 0 To UBound(ar)
  12.       ar(i) = Application.Small(br, i + 1)
  13.       d(ar(i)) = ""
  14.     Next
  15.     arr(k, 1) = Join(d.keys, ",")
  16.     d.RemoveAll
  17.   Next
  18.   [f2].Resize(UBound(arr), 1) = arr
  19. End Sub
复制代码

评分

参与人数 1鲜花 +2 收起 理由
宝贝万岁 + 2 感谢帮助

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-8-13 11:13 | 显示全部楼层
paciguard 发表于 2017-8-13 09:11
结果写到D列了。。。
Sub 按钮1_Click()
Dim a, b()

效果很好,好理解,谢谢了

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-8-13 11:21 | 显示全部楼层

感谢,类型不匹配,br(i) = int(ar(i)) 改为 br(i) = Val(ar(i)) 就ok了,又学了一种方法,开森~
您需要登录后才可以回帖 登录 | 免费注册 新浪微博登陆

本版积分规则

关闭

最新热点上一条 /1 下一条

关注官方微信,每天坐享新鲜教程

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

GMT+8, 2017-8-17 16:01 , Processed in 0.101519 second(s), 23 queries , Gzip On, MemCache On.

Powered by Discuz! X3.3

© 2001-2017 Wooffice Inc.

   

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

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

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