VBA按列名称或是按表格标题给EXCEL表格做排序
VBA给EXCEL表格做排序
按列名称或是按标题给表格排序
在VBA编程时,经常会对表格内容进⾏排序,为了⽅便对不同需求下的内容排序,编制了下⾯这个函数,此函数可以根据给定的列名称(A、B、C……),或是列的标题(“序号”、“姓名”、“年龄”……)进⾏排序,并且可以指定是升序或是降序。
本函数可以设置需要排序的开始⾏(标题⾏),默认为有标题⾏,默认为所有的列全部参与排序,表格的全部列数⼀般不超过26列。
本函数暂不⽀持对多列同时排序,有兴趣的可以对col_Name进⾏解析,并逐个添加排序列:Ws_Rec.Sort.SortFields.Add,可以实现多列排序。
引⽤⽅法:
Sort_Ws ActiveWorkbook.ActiveSheet, “A”, , xlDescending
Function Sort_Ws(Ws_Rec As Worksheet, Col_Name, Optional Row As Integer =1, Optional Sort As Integer = xlAscending)
'排序按照名称
Dim Last_Row As Integer
Dim Last_Col As Integer
On Error GoTo err
Sort_Ws = True
Last_Row = Ws_Rec.UsedRange.Rows(Ws_Rec.UsedRange.Rows.Count).Row
Last_Col = Ws_Rec.UsedRange.Columns(Ws_Rec.UsedRange.Columns.Count).Column
If Sort <> xlAscending Then Sort = xlDescending
If Not Col_Name Like "[a-zA-Z]" Then
Set Col_Name = Ws_Rec.Range(Row &":"& Row).Find(Col_Name, lookat:=xlWhole)
If Not Col_Name Is Nothing Then Col_Name = Col_Name.Column
Col_Name =Chr(64+ Col_Name)
End If
'Ws_Rec.Columns(Col_Name &":"& Col_Name).Select
Ws_Rec.Sort.SortFields.Clear
Ws_Rec.Sort.SortFields.Add Key:=Range(Col_Name & Row) _
, SortOn:=xlSortOnValues, Order:=Sort, DataOption:=xlSortNormal
With Ws_Rec.Sort
.SetRange Range("A"& Row &":"&Chr(64+ Last_Col)& Last_Row)
.Header = xlYes
.MatchCase = False
.
Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
vba排序函数sort用法End With
Exit Function
err:
Sort_Ws = err.Number &"_"& err.Description
End Function
根据⽹友的要求,更新了代码,可以实现多列排序。
引⽤⽅法:
Sort_Ws ActiveWorkbook.ActiveSheet, “A 1,名称 2”
或是
Sort_Ws ActiveWorkbook.ActiveSheet, “A,名称”, , xlDescending
⽀持列名与标题混排,可以在列后以空格标⽰排序⽅法,或是集中在最后指定
Function Sort_Ws(Ws_Rec As Worksheet, Col_Name, Optional Row As Integer =1, Optional Sort As Integer = xlAscending) '排序按照名称
Dim Last_Row As Integer
Dim Last_Col As Integer
Dim IsMuti As Boolean
Dim sp_ColName() As String
Dim sp_Sort() As Integer
Dim sp() As String
Dim tmp
On Error GoTo err
Sort_Ws = True
Last_Row = Ws_Rec.UsedRange.Rows(Ws_Rec.UsedRange.Rows.Count).Row
Last_Col = Ws_Rec.UsedRange.Columns(Ws_Rec.UsedRange.Columns.Count).Column
If Sort <> xlAscending Then Sort = xlDescending
Ws_Rec.Sort.SortFields.Clear
sp_ColName =Split(Col_Name,",")
ReDim sp_Sort(UBound(sp_ColName))
For i =LBound(sp_ColName) To UBound(sp_ColName)
If InStr(sp_ColName(i)," ")>0 Then
sp =Split(sp_ColName(i)," ")
sp_ColName(i)=sp(LBound(sp))
sp_Sort(i)=IIf(sp(UBound(sp))<>1,2,1)
Else
sp_Sort(i)= Sort
End If
If Not sp_ColName(i) Like "[a-zA-Z]" Then
Set tmp = Ws_Rec.Range(Row &":"& Row).Find(sp_ColName(i), lookat:=xlWhole)
If Not tmp Is Nothing Then sp_ColName(i)=Chr(64+ tmp.Column)
End If
Ws_Rec.Sort.SortFields.Add Key:=Range(sp_ColName(i)& Row) _
, SortOn:=xlSortOnValues, Order:=sp_Sort(i), DataOption:=xlSortNormal
Next
With Ws_Rec.Sort
.SetRange Range("A"& Row &":"&Chr(64+ Last_Col)& Last_Row)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Exit Function
err:
Sort_Ws = err.Number &"_"& err.Description
End Function
版权声明:本站内容均来自互联网,仅供演示用,请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198,我们将在24小时内删除。
发表评论