VBAスクリプトのコレクション【Excelのsheet名によるソート】
1576 ワード
詳細
ちょうど1つの问题に出会って、プログラムはExcelを処理した后に、sheetの顺番の顺番が乱れていることを発见して、谷先生に闻いたことがあって、1つの答えを得て、このシナリオを贴り出して、
バックアップとして使用します.
使用方法:
sheetの足元を右クリックして「コードの表示-」を開き、コード領域cp以上のスクリプト-」メニュー「実行」(またはF 5)を開き、保存します.
ちょうど1つの问题に出会って、プログラムはExcelを処理した后に、sheetの顺番の顺番が乱れていることを発见して、谷先生に闻いたことがあって、1つの答えを得て、このシナリオを贴り出して、
バックアップとして使用します.
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以上のスクリプト-」メニュー「実行」(またはF 5)を開き、保存します.