Как изменить порядок листов в определенном порядке, а затем в алфавитном порядке?

Question

Мне нужно изменить порядок своих листов в определенном порядке, а затем, если они еще остались, сделать это в алфавитном порядке. У меня есть макрос ниже, чтобы изменить их порядок в алфавитном порядке.

Если у меня есть листы "METALS", "SVOC", "GENCHEM" и т.д., Я хочу, чтобы они всегда были в алфавитном порядке. Затем любые другие листы "Яблоко", "Зебра", "Лев" должны располагаться в алфавитном порядке.

Я попробовал этот код, но не получилось

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

Answer 1

Я использовал следующий код. Приложение Sub SortWorksheetsTabs().ScreenUpdating = False Dim ShCount как целое число, i как целое число, j как целое число ShCount = листы.Подсчитать для i = 1 до ShCount - 1 для j = i + 1 до ShCount, если UCase(Sheets(j).Имя) <UCase(Sheets(i).Имя) Затем Листы (J).Переместить до:= Листы (i) Конец, если следующий j Следующий i Заявка.ScreenUpdating = True End Sub ''

Answer 2

Я вроде как сделал код заново. Это работает для меня. Заметьте, что я в некотором роде использую массив "Brute Force" для специальных листов, которые вам нужны в начале.

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