对话框选择排序的问题

hhxq001

想实现通过对话框选择某列进行排序，怎么搞才好呢，讨教

自定义排序问题.zip (26.97 KB, 下载次数: 7)

2022-12-9 22:38 上传

点击文件名下载附件

smsn

为什么不用excel自带的排序？
如果一定要用excel，
可以录一段排序的宏 或者 使用sql排序

hhxq001

smsn 发表于 2022-12-9 22:48
为什么不用excel自带的排序？
如果一定要用excel，
可以录一段排序的宏 或者 使用sql排序

因为实际上要锁定数据，不允许修改只可以排序

smsn

1.     With ActiveWorkbook.ActiveSheet.Sort
   
2.         .SortFields.Clear
   
3.         ActiveSheet.Sort.SortFields.Add2 Key:=Range("B3:B93") _
   
4.             , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   
5.         .SetRange Range("A2:M93")
   
6.         .Header = xlYes
   
7.         .MatchCase = False
   
8.         .Orientation = xlTopToBottom
   
9.         .SortMethod = xlPinYin
   
10.         .Apply
    
11.     End With

复制代码

hhxq001

这样实现了

Sub 自定义排序()
Dim arr, i&
'设置自定义排序的顺序
arr = Array("院校", "层次", "地区/城市", "类型", "性质", "排名", "专业录取概率", "专业代码", "计划", "学费", "学制", "最低位次")

x = InputBox("请在b--m之间选择要排序的列号", "排序")
If x > "a" Then

With Application
.ScreenUpdating = False
.AddCustomList ListArray:=arr
i = .GetCustomListNum(arr)
'x = Selection.Column '用鼠标所在的列排序

'设置排序的区域,不把序号列纳入排序范围
With Range("B2" & ":m" & Range("A65536").End(xlUp).Row)
'设置排序的起始单元格,即当前鼠标的位置
.Sort Key1:=Columns(x), Order1:=xlAscending, Header:=xlNo, OrderCustom:=i + 1, SortMethod:=xlPinYin, DataOption1:=xlSortNormal
End With
.DeleteCustomList ListNum:=i
.ScreenUpdating = True
MsgBox "排序完成", vbInformation
End With
Else
MsgBox "不能选择b--m之外的列"
End If
End Sub

hhxq001

发现弹窗输入排序列，不如鼠标点选快捷



Sub 鼠标点选列排序()
Dim arr, i&
'设置自定义排序的顺序
arr = Array("院校", "层次", "地区/城市", "类型", "性质", "排名", "专业录取概率", "专业代码", "计划", "学费", "学制", "最低位次")

With Application
.ScreenUpdating = False
.AddCustomList ListArray:=arr
i = .GetCustomListNum(arr)
x = Selection.Column '用鼠标所在的列排序

'设置排序的区域,不把序号列纳入排序范围
With Range("B2" & ":m" & Range("A65536").End(xlUp).Row)
.Sort Key1:=Columns(x), Order1:=xlAscending, Header:=xlNo, OrderCustom:=i + 1, SortMethod:=xlPinYin, DataOption1:=xlSortNormal
End With
.DeleteCustomList ListNum:=i
.ScreenUpdating = True
MsgBox "排序完成", vbInformation
End With

End Sub

smsn

不允许修改还能排序？
给你录了一个