• <tr id="5e2c16eb"><strong id="2bc8bbcd"></strong><small id="b1b6b24"></small><button id="6fee0f9d"></button><li id="63502255"><noscript id="53cade83"><big id="6ff384c1"></big><dt id="ac6e0d"></dt></noscript> </tr><ol id="6276c0ba"><option id="300dcc40"><table id="7082a41f"><blockquote id="473377d4"><tbody id="17093e56"></tbody></blockquote></table></option></ol><u id="77d2dc8c"></u><kbd id="3182c233"><kbd id="724a5c3"></kbd></kbd>
  • 千赢国际教程下载和软件下载中心,Microsoft技术社区联盟成员千赢国际平台,全球极具影响力的千赢国际门户,Office技术培训社区

    [千赢国际 VBA]自定义排序的三种方法

    2019-01-06  作者:千赢国际Home  阅读:
    诸君好,前前期我们聊了VBA编程和数据的常规排序……VBA常用小代码105:Rang对象的排序操作……
    今天我们再聊下自定义排序……
    何谓自定义排序,就是按指定的顺序对数据源进行排序呗……

    今一共分享了三种方法。
    第1种方法是系统自带的OrderCustom,优点是代码简洁,缺点是自定义序列有字符长度限制(255个)。
    第2种方法是字典+数组设置序列号,再使用了辅助列进行排序。优点是不会破坏单元格的形式和结构,比如单元格中存在的公式、背景等。
    第3种方法是只使用字典+数组,借助简单桶排序的技巧,直接对数据在数组中进行排序。优点是效率较高,缺点是会破坏单元格的结构,比如消除公式等。
    (第1种建议掌握,第2种建议了解,第3种……能懂就懂,不懂先放着吧~)

    举个例子。
    如下图所示千赢国际平台,A:C列是数据源。
    现需要根据E列所指定的部门先后顺序,对数据源进行重新排序千盈,如果部门不在指定序列内,则排放在数据源末尾。

    排序结果如下图。


    第1种方法代码如下:

    Sub FreeSort()
    'eh技术论坛 VBA编程学习与实践 看见星光
    Dim n&, rng As Range
    Set rng = Range("e2:e" & Cells(Rows.Count, "e").End(xlUp).Row)
    Application.AddCustomList (rng)
    '增加一个自定义序列,该参数除了支持单元格对象,也支持数组。
    n = Application.CustomListCount
    '自定义序列的数目
    Range("a:c").Sort key1:=[a1], order1:=xlAscending, Header:=xlYes, ordercustom:=n + 1
    '使用自定义排序,ordercustom指定使用哪个自定义序列排序。
    '当使用自定义排序时,需要将OrderCustom参数设置为指定的序列在自定义列表中的顺序加1
    Application.DeleteCustomList n
    '删除新增的自定义序列
    End Sub


    第2种方法代码如下:

    Sub DicSort()
    Dim d As Object, r, i&, arr, brr
    Set d = CreateObject("ing.dictionary")
    r = Range("e2:e" & Cells(Rows.Count, "e").End(xlUp).Row).Value
    For i = 1 To UBound(r)
    d(r(i, 1)) = i '目标序列循环装入字典,序号作为item
    Next
    arr = Range("a2:c" & Cells(Rows.Count, 1).End(xlUp).Row)
    '数据源装入数组arr
    ReDim brr(1 To UBound(arr), 1 To 1)
    '声明数组brr装原部门在指定序列中的序号
    For i = 1 To UBound(arr)
    If d.exists(arr(i, 1)) Then
    brr(i, 1) = d(arr(i, 1)) '将原部门在指定序列中的序列号装入brr
    Else
    brr(i, 1) = "指定序列不存在"
    End If
    Next
    [d:d].Insert
    '在D列插入一列
    [d2].Resize(UBound(brr), 1) = brr
    '新的序列号放入D列
    Range("a:d").Sort key1:=[d1], order1:=xlAscending, Header:=xlYes 'D列升序排序
    [d:d].Delete '删除D列
    Set d = Nothing
    End Sub


    第3种方法代码如下:

    Sub DicArrSort()
    'eh技术论坛公众号 VBA编程学习与实践 看见星光
    Dim d As Object, i&, n&, x&, k&, j&
    Dim r, arr, brr, crr
    Set d = CreateObject("ing.dictionary")
    '后期绑定字典
    r = Range("e2:e" & Cells(Rows.Count, "e").End(xlUp).Row).Value
    For i = 1 To UBound(r)
    d(r(i, 1)) = i '目标序列循环装入字典,序号作为item
    Next
    arr = Range("a2:c" & Cells(Rows.Count, 1).End(xlUp).Row)
    '数据源装入数组
    ReDim brr(1 To d.Count + 1, 1 To 1)
    'brr数组用于按序号装数组arr的行号,类似于桶排序的桶
    For i = 1 To UBound(arr)
    If d.exists(arr(i, 1)) Then
    '如果字典中存在相关部门……
    n = d(arr(i, 1))
    '该部门在指定序列中的序号
    brr(n, 1) = brr(n, 1) & "," & i
    '将该部门在arr中的行号装入数组brr对应的序号行
    Else
    brr(UBound(brr), 1) = brr(UBound(brr), 1) & "," & i
    '如果字典中不存在,放入数组brr最后一行
    End If
    Next
    ReDim crr(1 To UBound(arr), 1 To UBound(arr, 2))
    '数组crr放排序后的结果
    For i = 1 To UBound(brr)
    If brr(i, 1) <> "" Then
    '如果不为空,则有符合指定排序条件的关键词
    r = Split(brr(i, 1), ",")
    '将brr该位置储存的行号取出
    For x = 1 To UBound(r)
    k = k + 1 '累加行
    For j = 1 To UBound(arr, 2)
    crr(k, j) = arr(r(x), j)
    '遍历指定行位置数组arr的值移到crr
    Next
    Next
    End If
    Next
    Range("a2:c" & Cells(Rows.Count, 1).End(xlUp).Row) = crr
    '将数组crr排序后的结果放回单元格区域
    Set d = Nothing '释放字典
    Erase arr: Erase brr: Erase crr
    '释放数组
    End Sub


    题外话:
    之前我们讲过,数组和字典是VBA处理数据的最佳利器,这是由于数组可以提高计算效率,字典可以关联多个数据源构建各种关系,因此这里再次对学习VBA的童鞋们提个小建议,不要在单元格工作簿等对象上浪费太多时间,那是熟能生巧的事物,数组和字典才是学习VBA的核心要义哦。

    转载请注明来源"千赢国际Home"并保留原文链接。
    固定链接:http://ryansdrew.com/lesson/article/excel/1927.html
    分享到:
    Copyright 1999 - 2017 千赢国际 Home.All Rights Reserved.
    本站特聘法律顾问:徐怀玉律师 李志群律师   沪ICP备11019229号
           
    网站地图