ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 Office知识技巧免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 433|回复: 14
打印 上一主题 下一主题

[求助] 二维数组排序函数求教

[复制链接]

TA的精华主题

TA的得分主题

跳转到指定楼层
1
发表于 2020-8-26 10:43 | 只看该作者 |只看大图 回帖奖励 |倒序浏览 |阅读模式

想用二维数组排序,不要提取到边上表格,排序好了再提取回去。关键排序列为D列,是字符串列。求教,鲜花献上。

排序.zip

12.33 KB, 下载次数: 14

TA的精华主题

TA的得分主题

2
发表于 2020-8-26 11:07 | 只看该作者
  1. Sub text()
  2. Dim rng As Range
  3. Set rng = Range("a1:e" & Range("a65536").End(xlUp).Row)
  4. rng.Sort key1:=Range("c1"), order1:=1, Header:=xlYes
  5. End Sub
复制代码

将b列先删除,再运行上面的代码,因为合并单元格不好排序。这是利用单元格的sort方法。至于字符串用数组来排序,我也没用过。期待高人来写吧。

TA的精华主题

TA的得分主题

3
发表于 2020-8-26 11:09 | 只看该作者
dajiashiren 发表于 2020-8-26 11:07
将b列先删除,再运行上面的代码,因为合并单元格不好排序。这是利用单元格的sort方法。至于字符串用数组 ...

香川群子老师做过测试,EXCEL自带的排序方法速度比其他排序方法速度都快。

TA的精华主题

TA的得分主题

4
 楼主| 发表于 2020-8-26 12:08 | 只看该作者
chxw68 发表于 2020-8-26 11:09
香川群子老师做过测试,EXCEL自带的排序方法速度比其他排序方法速度都快。

自带的排序不能对合并单元格进行排序,A列合并单元格

TA的精华主题

TA的得分主题

5
 楼主| 发表于 2020-8-26 12:10 | 只看该作者

TA的精华主题

TA的得分主题

6
发表于 2020-8-26 12:27 | 只看该作者
本帖最后由 一把小刀闯天下 于 2020-8-26 12:33 编辑

'A、B列为什么要合并,不然手工排一下序就可以了

'凑了一个,应该差不多,,,

Option Explicit

Sub test()
  Dim arr, i, t
  arr = [a1].CurrentRegion.Offset(1).Resize(, 6).Value
  t = arr
  Call msort(arr, t, 1, UBound(arr, 1) - 1, 1, UBound(arr, 2), 4)
  [i2].Resize(UBound(arr, 1) - 1, UBound(arr, 2)) = arr
End Sub

Function msort(arr, temp, first, last, left, right, key)
  Dim i, j, k, kk, mid
  If first <> last Then
    mid = Int((first + last) / 2)
    msort arr, temp, first, mid, left, right, key
    msort arr, temp, mid + 1, last, left, right, key
    i = first: j = mid + 1: k = first
    While i <= mid And j <= last
      If StrComp(arr(i, key), arr(j, key), vbTextCompare) <= 0 Then
        For kk = left To right: temp(k, kk) = arr(i, kk): Next
        k = k + 1: i = i + 1
      Else
        For kk = left To right: temp(k, kk) = arr(j, kk): Next
        k = k + 1: j = j + 1
      End If
    Wend
    While i <= mid
      For kk = left To right: temp(k, kk) = arr(i, kk): Next
      k = k + 1: i = i + 1
    Wend
    While j <= last
      For kk = left To right: temp(k, kk) = arr(j, kk): Next
      k = k + 1: j = j + 1
    Wend
    For i = first To last
      For j = left To right
        arr(i, j) = temp(i, j)
      Next
    Next
  End If
End Function

评分

参与人数 2鲜花 +5 收起 理由
YZC51 + 3 太强大了
yes363001640 + 2 优秀作品

查看全部评分

TA的精华主题

TA的得分主题

7
发表于 2020-8-26 12:28 | 只看该作者
论坛很多数组排序代码函数的,谁便套一个应该就行,最常用的就是冒泡了,参数啥的可以根据自己的要求改改。

sub TEST()
Dim brr
brr = Range("a1").CurrentRegion
Range("a1").Resize(UBound(brr), UBound(brr, 2)) = Mp_Sort(brr, 2, UBound(brr), 4)
End Sub

Function Mp_Sort(Arr, Start, Last, skey)
    Dim i&, j&, t, k&
    For i = Last To Start + 1 Step -1
        For j = i - 1 To Start Step -1
            If Arr(i, skey) < Arr(j, skey) Then
                For k = 1 To UBound(Arr, 2)
                    t = Arr(i, k): Arr(i, k) = Arr(j, k): Arr(j, k) = t
                Next
            End If
        Next
    Next
    Mp_Sort = Arr
End Function

评分

参与人数 2鲜花 +5 收起 理由
YZC51 + 3 太强大了
yes363001640 + 2 感谢帮助

查看全部评分

TA的精华主题

TA的得分主题

8
 楼主| 发表于 2020-8-26 12:35 | 只看该作者

感谢小刀大神的帮助,合并是因为这个表格是第三方软件定死的格式,由第一张图片导出为第二张图片的,
而且是竖向累积的。

TA的精华主题

TA的得分主题

9
 楼主| 发表于 2020-8-26 12:37 | 只看该作者
wodewan 发表于 2020-8-26 12:28
论坛很多数组排序代码函数的,谁便套一个应该就行,最常用的就是冒泡了,参数啥的可以根据自己的要求改改。 ...

感觉帮助,我一直没找到对字符串为关键字进行排序的函数。收藏收藏

TA的精华主题

TA的得分主题

10
 楼主| 发表于 2020-8-26 12:40 | 只看该作者
一把小刀闯天下 发表于 2020-8-26 12:27
'A、B列为什么要合并,不然手工排一下序就可以了

'凑了一个,应该差不多,,,

为什么要合并的原因是:这个原表是第三方软件输出的格式。感谢帮助。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,高效办公专列,每天发车

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

GMT+8, 2020-9-12 01:14 , Processed in 0.081719 second(s), 16 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2021 Wooffice Inc.

   

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

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

快速回复 返回顶部 返回列表
百家乐app