当前位置: 代码迷 >> VBA >> 珍藏一段VBA脚本【根据Excel的sheet名排序】
  详细解决方案

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

热度:5691   发布时间:2013-02-26 00:00:00.0
收藏一段VBA脚本【根据Excel的sheet名排序】

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

做为备份。

?

Sub Sorting()Dim sCount As Integer, i As Integer, j As IntegerApplication.ScreenUpdating = FalsesCount = Worksheets.CountIf sCount = 1 Then Exit SubFor i = 1 To sCount - 1For j = i + 1 To sCountIf Worksheets(j).Name < Worksheets(i).Name ThenWorksheets(j).Move before:=Worksheets(i)End IfNext jNext iEnd SubSub SortSheet()Dim WsCount As IntegerDim WsArray() As StringDim Ws As WorksheetOn Error Resume NextWsCount = ActiveWorkbook.Worksheets.CountReDim WsArray(1 To WsCount)If ActiveWorkbook.ProtectStructure Then        MsgBox ActiveWorkbook.Name & " 被保护,不能进行排序,请解除保护后排序", _           vbCritical, "不能排序工作表"        Exit SubEnd IfFor Each Ws In ActiveWorkbook.Worksheets   t = t + 1   WsArray(t) = Ws.NameNext 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 jNext i'利用Move方法以及Sheets(i)移动工作表,按指定的顺序排列For i = 1 To WsCount   Worksheets(WsArray(i)).Move before:=Sheets(i)Next iEnd Sub
?

?使用方法:

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

  相关解决方案