Excel·VBA按指定顺序排序函数

这篇具有很好参考价值的文章主要介绍了Excel·VBA按指定顺序排序函数。希望对大家有所帮助。如果存在错误或未考虑完全的地方,请大家不吝赐教,您也可以点击"举报违法"按钮提交疑问。

与之前写过的《Excel·VBA数组冒泡排序函数》不同,不是按照数值大小的升序/降序对数组进行排序,而是按照指定数组的顺序,对另一个数组进行排序

以下代码调用了《Excel·VBA数组冒泡排序函数》bubble_sort_arr函数(如需使用代码需复制)

Function 按指定顺序排序(ByVal sorted, ByVal arr, Optional ByVal key_col& = 1, Optional start As Boolean = False)
    'sorted已排序的数组,arr数组第key_col列将按sorted顺序排序,arr如果是一维数组则key_col无意义,key_col从1开始计数
    'start参数为True时,arr数组第key_col列值的开头符合sorted中的值,也进行排序;否则排在最后(匹配模式)
    'sorted数组可以是一维或二维,都会读取为字典(从上往下从左往右顺序);返回数组从1开始计数
    Dim dict As Object, x&, a, c&, dc&, i&, j&, temp, result
    Set dict = CreateObject("scripting.dictionary"): On Error Resume Next
    For Each s In sorted  'sorted数组转换为字典,键为字符串,值为顺序号
        If Not dict.Exists(s) Then x = x + 1: dict(s) = x
    Next
    x = 0: dc = dict.Count: a = TypeName(UBound(arr, 2))  '利用报错判断,获取数组维数
    If a = "" Then  'arr为一维数组
        c = UBound(arr) - LBound(arr) + 1: ReDim temp(1 To c, 1 To 2): ReDim result(1 To c)
        For Each a In arr  'temp数组,第1列为对应arr的值,第2列为排序序号
            x = x + 1: temp(x, 1) = a
            For Each k In dict.keys
                If a = k Then
                    temp(x, 2) = dict(k): Exit For    '全部相同,使用排序序号
                ElseIf start And a Like k & "*" Then  '开头符合,使用排序序号+0.1
                    temp(x, 2) = dict(k) + 0.1: Exit For
                End If
            Next
            If Len(temp(x, 2)) = 0 Then temp(x, 2) = dc + 1  '都不符合,排在最后
        Next
        temp = bubble_sort_arr(temp, 2)  '调用函数排序
        For x = 1 To c  '排序结果写入result数组,并输出
            result(x) = temp(x, 1)
        Next
        按指定顺序排序 = result
    Else  'arr为二维数组
        If LBound(arr) = 0 Or LBound(arr, 2) = 0 Then  '转为从1开始计数
            arr = WorksheetFunction.Transpose(WorksheetFunction.Transpose(arr))
        End If
        c = UBound(arr): ReDim temp(1 To c, 1 To 2): ReDim result(1 To c, 1 To UBound(arr, 2))
        For x = 1 To c  'temp数组,第1列为对应arr的序号,第2列为排序序号
            temp(x, 1) = x: a = arr(x, key_col)  'key_col从1开始计数
            For Each k In dict.keys
                If a = k Then
                    temp(x, 2) = dict(k): Exit For    '全部相同,使用排序序号
                ElseIf start And a Like k & "*" Then  '开头符合,使用排序序号+0.1
                    temp(x, 2) = dict(k) + 0.1: Exit For
                End If
            Next
            If Len(temp(x, 2)) = 0 Then temp(x, 2) = dc + 1  '都不符合,排在最后
        Next
        temp = bubble_sort_arr(temp, 2)  '调用函数排序
        For i = 1 To c  '排序结果写入result数组,并输出
            x = temp(i, 1)
            For j = 1 To UBound(arr, 2)
                result(i, j) = arr(x, j)
            Next
        Next
        按指定顺序排序 = result
    End If
End Function
  • 举例1
Sub 排序测试1()
    Dim arr, brr, crr
    '一维数组
    arr = Array("A", "B", "C", "D", "E", "F")
    brr = Array("AA", "C", "BB", "B", "CC", "A")
    crr = 按指定顺序排序(arr, brr)
    [e1].Resize(1, UBound(crr)) = crr  '一维数组单行输出
    '二维数组
    arr = [a1].CurrentRegion: brr = [c1].CurrentRegion
    crr = 按指定顺序排序(arr, brr)
    [e1].Resize(UBound(crr), UBound(crr, 2)) = crr  '二维数组单列输出
End Sub

start参数为默认值False,字符串完全相同时确定序号
Excel·VBA按指定顺序排序函数,# Excel,VBA,算法,excel,算法,vba,排序算法
start参数为True,使用开头匹配模式,字符串完全相同或开头相同时确定序号,结果与上面不同
Excel·VBA按指定顺序排序函数,# Excel,VBA,算法,excel,算法,vba,排序算法

  • 举例2
Sub 按指定顺序排序_测试()
    Dim arr, brr, crr
    arr = [a1].CurrentRegion: brr = [c1].CurrentRegion
    crr = 按指定顺序排序(arr, brr, , True)  '开头匹配模式
    [f1].Resize(UBound(crr), UBound(crr, 2)) = crr
End Sub

start参数为True,使用开头匹配模式,字符串完全相同或开头相同时确定序号
Excel·VBA按指定顺序排序函数,# Excel,VBA,算法,excel,算法,vba,排序算法文章来源地址https://www.toymoban.com/news/detail-824169.html

到了这里,关于Excel·VBA按指定顺序排序函数的文章就介绍完了。如果您还想了解更多内容,请在右上角搜索TOY模板网以前的文章或继续浏览下面的相关文章,希望大家以后多多支持TOY模板网!

本文来自互联网用户投稿,该文观点仅代表作者本人,不代表本站立场。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如若转载,请注明出处: 如若内容造成侵权/违法违规/事实不符,请点击违法举报进行投诉反馈,一经查实,立即删除!

领支付宝红包 赞助服务器费用

相关文章

  • Excel VBA 复制除指定工作表外所有的工作表的内容到一张工作表中

    当我们有一张表里面有很多sheet 具有相同的表结构,如果需要汇总到一张表中,那么我们可以借助VBA 去实现汇总自动化 示例1 : 运行结果如下: 示例2 : 如下图所示 汇总的时候需要插入一个新列,填入各个sheetname ; 各个sheet 有合并单元格,汇总之后需要拆分合并单元格并

    2024年02月12日
    浏览(40)
  • EXCEL VBA从入门到精通 第九章:Excel VBA高级编程技巧

    介绍Excel VBA中的API编程,以及如何利用它们来访问Windows系统的功能。 Excel VBA提供了访问Windows系统API的功能,通过调用API函数可以访问Windows系统底层的功能和资源,例如操作系统、文件系统、网络、注册表等。API函数可以是Windows操作系统内置的函数,也可以是Windows DLL文件中

    2024年02月02日
    浏览(46)
  • EXCEL VBA从入门到精通 第一章:VBA入门

    介绍VBA的定义,作用和优点。 VBA(Visual Basic for Applications)是一种编程语言,是微软Office套件中的一个重要组成部分,主要用于自动化处理Office中的各种操作,包括Excel、Word、PowerPoint、Outlook等。 VBA是一种基于VB(Visual Basic)语言的编程语言,它具有简单易学、功能强大、灵

    2024年02月07日
    浏览(56)
  • 掌握 Microsoft Excel 宏和 Excel VBA

    掌握 Microsoft Excel 宏和 Excel VBA 基于项目的 Excel VBA(Visual Basic for Applications)和 Excel 宏课程 课程英文名:Master Microsoft Excel Macros and Excel VBA 此视频教程共27.0小时,中英双语字幕,画质清晰无水印,源码附件全 课程编号:286 百度网盘地址:https://pan.baidu.com/s/1ivLIGKt_3R0wncmCswMTR

    2024年02月05日
    浏览(41)
  • Excel VBA 语法基础

    VBA(Visual Basic for Applications)是一种用于宏编程和自动化任务的编程语言,广泛应用于 Microsoft Office 套件中的各种应用程序,如 Excel、Word 和 PowerPoint。掌握 VBA 基础语法可以帮助您通过编写自定义的宏来增强和自动化这些应用程序的功能。 本文将介绍 Excel VBA 的基础语法,帮

    2024年02月09日
    浏览(42)
  • Excel+VBA帮助

     目录 一、VBA 入门知识 1、激活工作簿 2、创建新工作簿 3、打开工作簿 4、用编号引用工作表 5、用名称引用工作表 6、将文档保存为 Web 页 7、用 A1 样式的记号引用单元格和单元格区域 8、用编号引用单元格 9、引用行或列 10、用快捷记号引用单元格 11、引用命名单元格区域

    2024年02月05日
    浏览(44)
  • 【一】Excel VBA开发 初探

    1、点击Excel左上角的【文件】,然后点击文件下方的【选项】 2、【Excel选项】中点击【自定义功能区】,右边勾选【开发工具】,点击【确定】  3、返回excel sheet 页面。点击【开发工具】,我们将看到三个我们开发过程中必用的按钮,分别是:【Visual Basic】、【宏】、【录制

    2024年02月11日
    浏览(45)
  • VBA技术资料MF35:VBA_在Excel中过滤数据

    【分享成果,随喜正能量】好马好在腿,好人好在嘴。不会烧香得罪神,不会讲话得罪人。慢慢的你就会发现,一颗好心,永远比不上一张好嘴。。 我给VBA的定义:VBA是个人小型自动化处理的有效工具。利用好了,可以大大提高自己的工作效率,而且可以提高数据的准确度。

    2024年02月14日
    浏览(35)
  • VBA技术资料MF43:VBA_Excel中自动填充

    【分享成果,随喜正能量】以时寝息,当愿众生,身得安隐,心无动乱。愿我们都能,梦见幸福!在踉跄中前进,在跌倒后跃进,逐渐强大.。 我给VBA的定义:VBA是个人小型自动化处理的有效工具。利用好了,可以大大提高自己的工作效率,而且可以提高数据的准确度。我的

    2024年02月12日
    浏览(31)
  • Excel·VBA合并工作簿2

    其他合并工作簿的方法,见之前的文章《Excel·VBA合并工作簿》 与之前的文章《Excel·VBA合并工作簿(3,合并文件夹下所有工作簿中所有工作表)》类似,但是按照表头名称,将表格数据汇总至合并表格,表头名称相同的在同一列 举例 共5个工作簿13个工作表,并且改变了C、

    2024年01月21日
    浏览(40)

觉得文章有用就打赏一下文章作者

支付宝扫一扫打赏

博客赞助

微信扫一扫打赏

请作者喝杯咖啡吧~博客赞助

支付宝扫一扫领取红包,优惠每天领

二维码1

领取红包

二维码2

领红包