精华内容
下载资源
问答
  • Excel VBA自定义序列排序

    千次阅读 2020-02-22 19:52:09
    在图1中所示的数据集中,如果希望按单元格区域E2:E6所列序列进行排序,需要先使用AddCustomList方法为应用程序添加自定义序列,示例代码如下。 Sub SortByLists() Dim avntList As Variant, lngNum As Long ...

    在这里插入图片描述
    图1 待排序数据集
    在图1中所示的数据集中,如果希望按单元格区域E2:E6所列序列进行排序,需要先使用AddCustomList方法为应用程序添加自定义序列,示例代码如下。

    Sub SortByLists()
         Dim avntList As Variant, lngNum As Long
         avntList = Range("E2:E6")
         Application.AddCustomList avntList
         lngNum = Application.GetCustomListNum(avntList)
         Range("A1").Sort Key1:=Range("A1"), _
             Order1:=xlAscending, Header:=xlYes, _
             OrderCustom:=lngNum + 1
         Application.DeleteCustomList lngNum
     End Sub
    

    在这里插入图片描述
    图2 排序结果

    第4行代码通过Application对象的AddCustomList方法为应用程序添加一个自定义序列。AddCustomList方法为自定义自动填充(或自定义排序)添加自定义列表,其语法格式如下。

    AddCustomList(ListArray, ByRow)

    其中,参数ListArray是必需的,可以为字符串数组或Range对象。参数ByRow是可选的,仅当 ListArray 为 Range 对象时使用。如果为 True,则使用区域中的每一行创建自定义列表;如果为 False,则使用区域中的每一列创建自定义列表。如果省略该参数,并且区域中的行数比列数多(或者行数与列数相等),则 Microsoft Excel 使用区域中的每一列创建自定义列表。如果省略该参数,并且区域中的列数比行数多,则 Microsoft Excel 使用区域中的每一行创建自定义列表。

    如果要添加的列表已经存在,则AddCustomList方法不起作用。

    第5行返回avnList数组在自定义序列中的序号。

    第6行使用Sort方法对当前数据排序,其中Sort的参数指定了第1关键字Key1,默认为升序排列,同时设置包含标题,并且指定按新添加的自定义序列索引号排序。

    注:参数OrderCustom指定在自定义排序次序列表中的基于1的整数偏移,在指定该参数时需在自定义序列号基础上加1。

    第9行代码使用DeleteCustomList方法删除新添加的自定义序列。

    微信公众号:VBA168

    淘宝店铺地址:https://item.taobao.com/item.htm?spm=a1z10.1-c-s.w4004-21233576391.4.1af0683dzrx3oU&id=584940166162

    关注微信公众号,每天及时接收Excel VBA经典示例讲解。

    淘宝店铺提供Excel定制服务。

    祝你工作和学习更轻松!

    展开全文
  • 诸君好,前前期我们聊了VBA编程和数据的常规排序……VBA常用小代码105:Rang对象的排序操作……今天我们再聊下自定义排序……何谓自定义排序,就是按指定的顺序对数据源进行排序呗……今一共分享了三种方法。...

    诸君好,前前期我们聊了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的核心要义哦。

    转载于:https://www.cnblogs.com/medik/p/11026422.html

    展开全文
  • 诸君好,前前期我们聊了VBA编程和数据的常规排序……VBA常用小代码105:Rang对象的排序操作……今天我们再聊下自定义排序……何谓自定义排序,就是按指定的顺序对数据源进行排序呗……今一共分享了三种方法。...

    诸君好,前前期我们聊了VBA编程和数据的常规排序……VBA常用小代码105:Rang对象的排序操作……

    今天我们再聊下自定义排序……

    何谓自定义排序,就是按指定的顺序对数据源进行排序呗……

    今一共分享了三种方法。

    第1种方法是系统自带的OrderCustom,优点是代码简洁,缺点是自定义序列有字符长度限制(255个)。

    第2种方法是字典+数组设置序列号,再使用了辅助列进行排序。优点是不会破坏单元格的形式和结构,比如单元格中存在的公式、背景等。

    第3种方法是只使用字典+数组,借助简单桶排序的技巧,直接对数据在数组中进行排序。优点是效率较高,缺点是会破坏单元格的结构,比如消除公式等。

    (第1种建议掌握,第2种建议了解,第3种……能懂就懂,不懂先放着吧~)

    举个例子。

    如下图所示,A:C列是数据源。

    现需要根据E列所指定的部门先后顺序,对数据源进行重新排序,如果部门不在指定序列内,则排放在数据源末尾。

    3eb7f92982d23f58f2cfec49684c93a3.png

    排序结果如下图。

    45eedd9d30c0b124f14ac0c457bd885f.png

    第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的核心要义哦。

    展开全文
  • 96.导出VBA Project代码 97.导入VBA Project代码 98.取得汉字拼音的第一个字母 99.获取两栏中相同的数据 100.选取当前工作表中公式出错的单元格﹐关返回出错个数 101.将工作表中最后一列作为页脚打印在每一面页尾 ...
  • 函数作用:导入VBA Project代码.....................97 '98.函数作用:取得汉字拼音的第一个字母.................98 '99.函数作用:获取两栏中相同的数据....................100 '100.函数作用:选取当前工作表中公式...
  • VBA常用技巧

    2014-12-21 16:39:28
    技巧189 保护VBA代码 12 189-1 设置工程密码 12 189-2 设置“工程不可查看” 12 技巧190 优化代码 12 190-1 关闭屏幕刷新 12 190-2 使用工作表函数 12 190-3 使用更快的单元格操作方法 12 190-4 使用With语句引用...
  • VBA编程技巧大全

    2013-08-05 09:03:19
    技巧189 保护VBA代码 459 189-1 设置工程密码 459 189-2 设置“工程不可查看” 460 技巧190 优化代码 462 190-1 关闭屏幕刷新 462 190-2 使用工作表函数 464 190-3 使用更快的单元格操作方法 465 190-4 使用With语句...
  • 最新Excel VBA活用范例大辞典 光盘

    热门讨论 2012-01-31 13:58:10
     第18章介绍的范例是如何获取VBA工程的信息、如何操作VBA工程、如何在运行时创建用户窗体和控件、如何在运行时自动编写程序代码等技巧。这些技巧可以作为提高ExcelVBA使用技能的基础和参考依据。  第19章介绍的...
  • 文字按插入点自动对齐提供了对自定义数据类型的数组进行排序的一个思路;提取多行文字中的文字内容对AutoCAD中多行文字的格式代码进行了分析。使用ObjectDBX实现的批量文字替换,与上一个版本比较起来,修正了一些...
  • 单元格选择技巧与选区统计、单元格数据处理技巧、条件格式及数据突现方式、排序、数据筛选、处理图形与艺术字、处理图表中的技巧、控制工作表、多工作表操作、工作表页面设置与打印、工作簿安全处理、文件与目录、...
  • 单元格选择技巧与选区统计、单元格数据处理技巧、条件格式及数据突现方式、排序、数据筛选、处理图形与艺术字、处理图表中的技巧、控制工作表、多工作表操作、工作表页面设置与打印、工作簿安全处理、文件与目录、...
  • 中文版Excel.2007高级VBA编程宝典 1/2

    热门讨论 2012-04-06 16:00:16
     7.6.2 VBA代码的存储  7.6.3 VBA代码的输入  7.7 VBE环境的定制  7.7.1 使用“编辑器”选项卡  7.7.2 使用“编辑器格式”选项卡  7.7.3 使用“通用”选项卡  7.7.4 使用“可连接的”选项卡  7.8 宏录制器 ...
  • 01069获取Excel命令按钮的外观图像和FaceID号(添加到自定义工具栏) 01070获取Excel命令按钮的外观图像和FaceID号(输出到工作表) 01071改变Excel命令按钮的外观图像 01072删除、恢复Excel菜单栏和工具栏 01073...
  • 自定义查找最大值函数findMax(),功能:查找给定区域内的最大值(按字典排序,数字小于字母,大写字母小于小写字母)代码:Function findMax(ByVal rng As Range) '求最大值 Dim max As Variant max = rng.Cells(1)....

    自定义查找最大值函数findMax(),功能:查找给定区域内的最大值(按字典排序,数字小于字母,大写字母小于小写字母)



    代码:

    Function findMax(ByVal rng As Range)
    '求最大值
    Dim max As Variant
    max = rng.Cells(1).Value
    
    For Each ce In rng
        If ce.Value > max Then
        max = ce.Value
        End If
    Next
    findMax = max
    End Function

    局限性:

    和Excel自带的Max()函数相比,运算速度明显偏慢。但是,Excel自带的max()只能返回一组数字中的最大值,而自定义的findMax函数不限制单元格内的数据类型。

    展开全文
  • 工程解密功能可以解除VBA工程不可查看的OFFICE工程文档,解除后重新打开文档可100%准确还原源代码,是VBA开发者的必备利器。采用字典补码查漏纠错技术实现台湾繁体系统中繁简转换与GB2BIG5转换准确率达100%,达到微软...
  • 3使用VBA代码控制数据透视表保持固定格式.xls4.1.4控制数据透视表的合并标志.xls4.1.5为数据透视表的每项后面插入空行.xls4.1.6-2快速设置数据透视表的分类汇总格式.xls4.1.6-3在数据透视表中快速选取同类数据....
  • 工程解密功能可以解除VBA工程不可查看的EXCEL工程文档,解除后重新打开文档可100%准确还原源代码,结合Office编程百宝箱成为VBA开发者的必备利器。更内置了比Vlookup()函数更强大且好用的VlookupIn()函数。能对VBA宏程...
  • PROJECT 2007宝典 9/9

    2012-04-01 19:13:00
    本书最后的部分介绍如何自定义Project以及宏和VBA的相关信息,并通过一些案例来帮助您了解Project的使用情况。  本书内容丰富,融合了作者大量的实践经验,适用于各类项目管理人员使用。 目录 -------------------...
  • 13.4 在VBA代码中引用图表和图表对象 295 13.5 创建图表 296 13.5.1 指定图表的大小和位置 296 13.5.2 引用特定的图表 297 13.6 录制“布局”和“设计”选项卡中的命令 299 13.6.1 指定内置的图表类型 ...
  • 13.4 在VBA代码中引用图表和图表对象 295 13.5 创建图表 296 13.5.1 指定图表的大小和位置 296 13.5.2 引用特定的图表 297 13.6 录制“布局”和“设计”选项卡中的命令 299 13.6.1 指定内置的图表类型 ...
  • 382.5 探索窗体设计视图和VBA类模块 392.6 现实世界—所学知识的透视 40第3章 Access导航 423.1 理解Access功能和模式 423.1.1 定义Access功能 423.1.2 定义Access操作模式 443.2 理解Access的表显示 443.2.1 最大化...
  • 382.5 探索窗体设计视图和VBA类模块 392.6 现实世界—所学知识的透视 40第3章 Access导航 423.1 理解Access功能和模式 423.1.1 定义Access功能 423.1.2 定义Access操作模式 443.2 理解Access的表显示 443.2.1 最大化...
  • 382.5 探索窗体设计视图和VBA类模块 392.6 现实世界—所学知识的透视 40第3章 Access导航 423.1 理解Access功能和模式 423.1.1 定义Access功能 423.1.2 定义Access操作模式 443.2 理解Access的表显示 443.2.1 最大化...
  • 382.5 探索窗体设计视图和VBA类模块 392.6 现实世界—所学知识的透视 40第3章 Access导航 423.1 理解Access功能和模式 423.1.1 定义Access功能 423.1.2 定义Access操作模式 443.2 理解Access的表显示 443.2.1 最大化...
  • 然后逐步介绍创建数据透视表、自定义透视表、查看视图数据、在透视表内进行计算、使用数据透视图等可视化工具、分析数据源、共享数据表、使用和分析OLAP数据、在透视表中使用宏和VBA等内容,并集中解答了一些常见的...
  • Excel百宝箱9.0无限制破解版

    热门讨论 2012-02-03 19:05:29
    【错误代码查询】:查询VBA错误ID号对应的原因及解决办法 【VBA窗体帮助信息查询】:窗体相关的VBA帮助查询,包括事件、方法、属性、对象、集合与控件 【函数运算符符语法查询】:VBA函数以及运算符相关的帮助查询 ...
  • Excel百宝箱

    2012-10-27 17:09:21
    【错误代码查询】:查询VBA错误ID号对应的原因及解决办法 【VBA窗体帮助信息查询】:窗体相关的VBA帮助查询,包括事件、方法、属性、对象、集合与控件 【函数运算符符语法查询】:VBA函数以及运算符相关的帮助查询 ...
  • │ │ 技巧189 解读时间格式代码.xls │ │ 技巧190 将角度显示为度分秒以及相关转换计算.xls │ │ │ ├─第19章-数学与三角计算 │ │ 技巧191 常用数值舍入计算.xls │ │ 技巧192 按人民币面额估算备钞数...
  • 【错误代码查询】:查询VBA错误ID号对应的原因及解决办法 【VBA窗体帮助信息查询】:窗体相关的VBA帮助查询,包括事件、方法、属性、对象、集合与控件 【函数运算符符语法查询】:VBA函数以及运算符相关的帮助查询 ...
  • 【隔行插入行】对工作表隔行插入行,或者隔列插入列,其中行数可以自定义 【折分工作簿】将指定工作簿的每个工作表拆分成单独的工作簿,新工作簿名称等于原工作表名称 【工作表折分】将当前工作表的数据按条件拆分成...

空空如也

空空如也

1 2 3
收藏数 46
精华内容 18
关键字:

vba自定义排序代码