我需要按特定顺序重新排列我的工作表,然后如果还有剩余,则按字母顺序排列。我有下面的宏来按字母顺序重新排列它们。
如果我有“METALS”、“SVOC”、“GENCHEM”等工作表,我希望它们始终按字母顺序排列。那么其他工作表“Apple”、“zebra”、“Lion”应按字母顺序排列。
我试过这个代码,但没有成功
Sheets("GENCHEM").Move Before:=Sheets(1)
Sheets("METALS").Move Before:=Sheets(2)
Sheets("PCBS").Move Before:=Sheets(3)
Sheets("OC_PEST").Move Before:=Sheets(4)
Sheets("SVOC").Move Before:=Sheets(5)
Sheets("VOC").Move Before:=Sheets(6)
'------- 以下是我的工作宏----
Option Explicit
Sub reordersheets()
'---Reorders the Sheets---
Dim N As Integer
Dim M As Integer
Dim FirstWSToSort As Integer
Dim LastWSToSort As Integer
Dim SortDescending As Boolean
SortDescending = False
If ActiveWindow.SelectedSheets.Count = 1 Then
FirstWSToSort = 1
LastWSToSort = Worksheets.Count
Else
With ActiveWindow.SelectedSheets
For N = 2 To .Count
If .Item(N - 1).Index <> .Item(N).Index - 1 Then
MsgBox "You cannot sort non-adjacent sheets"
Exit Sub
End If
Next N
FirstWSToSort = .Item(1).Index
LastWSToSort = .Item(.Count).Index
End With
End If
For M = FirstWSToSort To LastWSToSort
For N = M To LastWSToSort
If SortDescending = True Then
If UCase(Worksheets(N).Name) > UCase(Worksheets(M).Name) Then
Worksheets(N).Move Before:=Worksheets(M)
End If
Else
If UCase(Worksheets(N).Name) < UCase(Worksheets(M).Name) Then
Worksheets(N).Move Before:=Worksheets(M)
End If
End If
Next N
Next M
End Sub
答案1
我重新编写了代码。这对我来说很管用。请注意,我使用数组“强力”地获取了您在开始时需要的特殊表格。
Option Base 1
Sub t()
Dim shtArray() As String
Dim i As Long, k As Long
Dim ws As Worksheet
Dim R As Range
Dim n As Long
' Let's "brute force" your specific sheets to the front
Dim exceptionSheets() As Variant
exceptionSheets = Array("GENCHEM", "METALS", "OC_PEST", "PCBS", "SVOC", "VOC")
For i = 1 To ActiveWorkbook.Sheets.Count
If Not UBound(Filter(exceptionSheets, ActiveWorkbook.Sheets(i).Name)) > -1 Then
k = k + 1
Debug.Print Sheets(i).Name
ReDim Preserve shtArray(k)
shtArray(k) = ActiveWorkbook.Sheets(i).Name
End If
Next i
Application.ScreenUpdating = False
' Thanks to http://www.cpearson.com/excel/SortingArrays.aspx
' create a new sheet
Set ws = ThisWorkbook.Worksheets.Add
' put the array values on the worksheet
Set R = ws.Range("A1").Resize(UBound(shtArray) - LBound(shtArray) + 1, 1)
R = Application.Transpose(shtArray)
' sort the range
R.Sort key1:=R, order1:=xlAscending, MatchCase:=False
' load the worksheet values back into the array
For n = 1 To R.Rows.Count
shtArray(n) = R(n, 1)
Next n
' delete the temporary sheet
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
' Now, sort the sheets.
For i = UBound(exceptionSheets) To 1 Step -1
Sheets(exceptionSheets(i)).Move after:=Sheets(1)
Next i
For i = UBound(shtArray) To LBound(shtArray) Step -1
Sheets(shtArray(i)).Move after:=Sheets(7 + i - 1)
Next i
End Sub
答案2
我使用了以下代码。'' Sub SortWorksheetsTabs() Application.ScreenUpdating = False Dim ShCount As Integer, i As Integer, j As Integer ShCount = Sheets.Count For i = 1 To ShCount - 1 For j = i + 1 To ShCount If UCase(Sheets(j).Name) < UCase(Sheets(i).Name) Then Sheets(j).Move before:=Sheets(i) End If Next j Next i Application.ScreenUpdating = True End Sub''