ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[求助] 求最少去掉几个数字后,形成降序排列

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-2-19 11:39 | 显示全部楼层 |阅读模式
任意输入7个数字,如:7  ,6.9 ,4 ,1.8 ,5 ,3 ,2
输出结果应该是去掉2个,降序排列为: 7  ,6.9 ,5 ,3 ,2       

TA的精华主题

TA的得分主题

发表于 2018-2-19 12:02 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
楼主可以考虑从后向前遍历
发现前面一个数字如果小的话就删除即可

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-2-19 12:34 | 显示全部楼层
那如果是 6.9 ,4 ,1.8 ,5 ,3 ,2 ,7,那只能留下一个 7 了

TA的精华主题

TA的得分主题

发表于 2018-2-19 12:52 | 显示全部楼层
Sub test()
arr = Range("A1:A7")
For h = 2 To 7
   For i = h To 2 Step -1
   If arr(h, 1) > arr(i - 1, 1) Then
      arr(i - 1, 1) = Empty
   End If
   Next i
   Next h
   
   Range("B1:B7") = arr
End Sub

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-2-19 13:15 | 显示全部楼层
maditate 发表于 2018-2-19 12:52
Sub test()
arr = Range("A1:A7")
For h = 2 To 7

那如果是 6.9 ,4 ,1.8 ,5 ,3 ,2 ,7,那只能留下一个 7 了
应该是 6.9 ,5 ,3 ,2 ,
或者是 6.9 ,4 ,3 ,2 ,

TA的精华主题

TA的得分主题

发表于 2018-2-19 14:49 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
a1999zqw 发表于 2018-2-19 13:15
那如果是 6.9 ,4 ,1.8 ,5 ,3 ,2 ,7,那只能留下一个 7 了
应该是 6.9 ,5 ,3 ,2 ,
或者是 6.9  ...

留什么数不重要,重要的是规则。你把7写在最后,你也没告诉别人应该怎么留。从你给你例子来分析规则,如果7写在最后,那么就只能只留下7了。

TA的精华主题

TA的得分主题

发表于 2018-2-19 14:50 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
a1999zqw 发表于 2018-2-19 13:15
那如果是 6.9 ,4 ,1.8 ,5 ,3 ,2 ,7,那只能留下一个 7 了
应该是 6.9 ,5 ,3 ,2 ,
或者是 6.9  ...

留什么数不重要,重要的是规则。你把7写在最后,你也没告诉别人应该怎么留。从你给你例子来分析规则,如果7写在最后,那么就只能只留下7了。

TA的精华主题

TA的得分主题

发表于 2018-2-20 08:45 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
牵扯着排列与组合。

TA的精华主题

TA的得分主题

发表于 2018-2-20 17:15 来自手机 | 显示全部楼层
本帖最后由 lss001 于 2018-2-21 15:46 编辑

Sub ps() '7位数组合最长降序
Dim x(1 To 127)
y = Application.Transpose([a1:a7]) '指定单元格
For i = 1 To 7
    x(i) = y(i)
For j = i + 1 To 7
    k = k + 1
    If y(i) > y(j) Then
    x(7 + k) = y(i) & "," & y(j)
    End If
For l = j + 1 To 7
    m = m + 1
    If (y(i) > y(j)) * (y(j) > y(l)) Then
    x(28 + m) = y(i) & "," & y(j) & "," & y(l)
    End If
For n = l + 1 To 7
    o = o + 1
    If (y(i) > y(j)) * (y(j) > y(l)) * (y(l) > y(n)) Then
    x(63 + o) = y(i) & "," & y(j) & "," & y(l) & "," & y(n)
    End If
For p = n + 1 To 7
    q = q + 1
    If (y(i) > y(j)) * (y(j) > y(l)) * (y(l) > y(n)) * (y(n) > y(p)) Then
    x(98 + q) = y(i) & "," & y(j) & "," & y(l) & "," & y(n) & "," & y(p)
    End If
For r = p + 1 To 7
    s = s + 1
    If (y(i) > y(j)) * (y(j) > y(l)) * (y(l) > y(n)) * (y(n) > y(p)) * (y(p) > y(r)) Then
    x(119 + s) = y(i) & "," & y(j) & "," & y(l) & "," & y(n) & "," & y(p) & "," & y(r)
    End If
For t = r + 1 To 7
    u = u + 1
    If (y(i) > y(j)) * (y(j) > y(l)) * (y(l) > y(n)) * (y(n) > y(p)) * (y(p) > y(r)) * (y(r) > y(t)) Then
    x(126 + u) = y(i) & "," & y(j) & "," & y(l) & "," & y(n) & "," & y(p) & "," & y(r) & "," & y(t)
    End If
Next t, r, p, n, l, j, i
For g = 127 To 1 Step -1
If x(g) <> "" Then Cells(1, 2) = x(g): Exit Sub
'只提取最后一组符合要求结果
Next
End Sub
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-29 09:27 , Processed in 0.044350 second(s), 9 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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