Excel精英培训网

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

[已解决]关于按重复次数排序的问题

[复制链接]
发表于 2016-11-16 12:45 | 显示全部楼层 |阅读模式
本帖最后由 Gy奔跑吧小不点 于 2016-11-16 14:12 编辑

希望每行能根据重复次数从多到少的方式来进行排序,例子请看附件,请求帮助,谢谢。
最佳答案
2016-11-16 13:32
  1. Sub 按重复次数排序()
  2.     Dim arr, d
  3.     Set d = CreateObject("scripting.dictionary")
  4.     arr = Range("a1").CurrentRegion
  5.     For i = 1 To UBound(arr)
  6.         n = [ai1].Column - 1
  7.         For j = 1 To UBound(arr, 2)
  8.             d(arr(i, j)) = d(arr(i, j)) + 1
  9.         Next
  10.         For j = UBound(arr, 2) To 2 Step -1
  11.             For Each a In d.keys
  12.                 If d(a) = j Then
  13.                     n = n + 1: Cells(i, n) = a
  14.                 End If
  15.             Next
  16.         Next
  17.         d.RemoveAll
  18.     Next
  19. End Sub
复制代码

提取综合.rar

13 KB, 下载次数: 8

发表于 2016-11-16 13:32 | 显示全部楼层    本楼为最佳答案   
  1. Sub 按重复次数排序()
  2.     Dim arr, d
  3.     Set d = CreateObject("scripting.dictionary")
  4.     arr = Range("a1").CurrentRegion
  5.     For i = 1 To UBound(arr)
  6.         n = [ai1].Column - 1
  7.         For j = 1 To UBound(arr, 2)
  8.             d(arr(i, j)) = d(arr(i, j)) + 1
  9.         Next
  10.         For j = UBound(arr, 2) To 2 Step -1
  11.             For Each a In d.keys
  12.                 If d(a) = j Then
  13.                     n = n + 1: Cells(i, n) = a
  14.                 End If
  15.             Next
  16.         Next
  17.         d.RemoveAll
  18.     Next
  19. End Sub
复制代码

提取综合.rar

11.63 KB, 下载次数: 8

回复

使用道具 举报

 楼主| 发表于 2016-11-16 14:11 | 显示全部楼层
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 08:22 , Processed in 0.486484 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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