ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

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

[复制链接]

TA的精华主题

TA的得分主题

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

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

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

6.62 KB, 下载次数: 18

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, 下载次数: 11

评分

1

查看全部评分

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 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
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

查看全部评分

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

查看全部评分

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了,又学了一种方法,开森~
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-28 22:41 , Processed in 0.059496 second(s), 16 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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