收藏一段VBA脚本【根据Excel的sheet名排序】

刚刚遇到一个问题,程序处理完Excel之后,发现sheet的序号排序乱了,问过谷老师,拿到一个答案,贴出这段脚本,

做为备份。

 

Sub Sorting()
Dim sCount As Integer, i As Integer, j As Integer
Application.ScreenUpdating = False
sCount = Worksheets.Count
If sCount = 1 Then Exit Sub
For i = 1 To sCount - 1
For j = i + 1 To sCount
If Worksheets(j).Name < Worksheets(i).Name Then
Worksheets(j).Move before:=Worksheets(i)
End If
Next j
Next i
End Sub

Sub SortSheet()
Dim WsCount As Integer
Dim WsArray() As String
Dim Ws As Worksheet
On Error Resume Next
WsCount = ActiveWorkbook.Worksheets.Count
ReDim WsArray(1 To WsCount)
If ActiveWorkbook.ProtectStructure Then
        MsgBox ActiveWorkbook.Name & " 被保护,不能进行排序,请解除保护后排序", _
           vbCritical, "不能排序工作表"
        Exit Sub
End If
For Each Ws In ActiveWorkbook.Worksheets
   t = t + 1
   WsArray(t) = Ws.Name
Next Ws
'对数组进行排序
For i = 1 To UBound(WsArray) - 1
   For j = i + 1 To UBound(WsArray)
         If WsArray(i) > WsArray(j) Then
              t = WsArray(i)
              WsArray(i) = WsArray(j)
              WsArray(j) = t
         End If
   Next j
Next i
'利用Move方法以及Sheets(i)移动工作表,按指定的顺序排列
For i = 1 To WsCount
   Worksheets(WsArray(i)).Move before:=Sheets(i)
Next i
End Sub
 

 使用方法:

在sheet底脚右击打开“查看代码”-》在代码区域cp以上脚本-》菜单“运行”(或者F5),保存即可!

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值