按字母顺序排序后按颜色排序

Question

我有一张工作簿，大约有50张。我想编写一个按字母顺序排序的模块，然后在名为“Closed =>”的选项卡之后将具有黑色选项卡的表单移动到最后。

Sub sortsheets() 
    Dim WB As Workbook 
    Dim WS_Count As Integer 
    Dim i As Integer 
    Dim j As Integer 

    Set WB = ActiveWorkbook 
    WS_Count = WB.Sheets.count 


'Below will sort alphabetically  
    For i = 1 To WS_Count 
     For j = 1 To WS_Count - 1 

      If UCase(Sheets(j).name) > UCase(Sheets(j + 1).name) Then 
       Sheets(j).Move after:=Sheets(j + 1) 
      End if 

     Next j 
    Next i 


' Move closed tab to the end 
    For i = 1 To WS_Count 
     If UCase(Sheets(i).name) = "Closed =>" Then 
     Sheets(i).Move after:=Sheets(WS_Count) 
     End If 
    Next i 

' Below needs to iterate through the sheets and move all black sheets to the end 

    For i = 1 To WS_Count 

     For j = 1 To WS_Count 

      If Sheets(j).Tab.ColorIndex = 1 Then 
       Sheets(j).Move after:=Sheets(WS_Count) 

      End If 
     Next j 
    Next i 


    End Sub 

问题是，最后一步将黑色页面移动到结尾处将废弃字母顺序。我认为那是因为在它继续循环的时候，它正在穿过已经移动到最后的黑色床单，并再次移动它们。我怎样才能防止呢？

Answer 1

这将保持全黑张数保持在第一循环中完成排序：

Option Explicit 

Sub sortSheets() 
    Dim wb As Workbook, wsCount As Integer, i As Long, j As Long, bCount As Long 

    Set wb = ActiveWorkbook 
    wsCount = wb.Sheets.Count 

    Application.ScreenUpdating = False 

    For i = 1 To wsCount 'sort alpha 
     For j = 1 To wsCount - 1 
      If UCase(Sheets(j).Name) > UCase(Sheets(j + 1).Name) Then 
       Sheets(j).Move After:=Sheets(j + 1) 
      End If 
     Next 
    Next 

    For i = 1 To wsCount 'move closed tab to the end 
     If UCase(Sheets(i).Name) = UCase("Closed =>") Then 
      Sheets(i).Move After:=Sheets(wsCount) 
     End If 
     If Sheets(i).Tab.ColorIndex = 1 Then bCount = bCount + 1 
    Next I 

    For i = 1 To wsCount - bCount 'move black sheets to the end 
     If Sheets(i).Tab.ColorIndex = 1 Then 
      Sheets(i).Move After:=Sheets(wsCount) 
      i = i - 1 
     End If 
    Next 

    Application.ScreenUpdating = True 

End Sub 

Answer 2

我想如果你扭转你的操作顺序，做颜色排序第一更容易。我会通过标签颜色将图纸分成多个集合。最后，您可以按字母顺序对这些集合中的每一个进行排序。

注：此输入我的手机上，所以随时留意拼写错误，并这样;）

Option Explicit 

Sub sortSheets() 
    Dim wb As Workbook, Sheet As Worksheet, CloseSheet As Worksheet, BlackTabs As New Collection, OtherTabs as New Collection 

    Set wb = ActiveWorkbook 
    Application.ScreenUpdating = False 

    For Each Sheet in wb.Worksheets 
     If Ucase(Sheet.Name) = Ucase("Closed =>") Then Set CloseSheet=Sheet 

     Select Case Sheet.Tab.ColorIndex 
     Case 1 
      Sheet.Move After:=Sheets(wb.Sheets.Count) 
      BlackTabs.Add Sheet 
     Case Else 
      OtherTabs.Add Sheet 
     End Select 
    Next 

    If BlackTabs.Count >= 1 Then SortAlpha BlackTabs 
    If OtherTabs.Count >= 1 Then SortAlpha OtherTabs 

CloseSheet.Move After:=Sheets(wb.Sheets.Count) 

    Application.ScreenUpdating = True 

End Sub 

Private Sub SortAlpha (ByRef SortSheets as Collection) 
    Dim i as Long, j as Long 
    For i = 1 To SortSheets.Count 
     For j = 1 To SortSheets.Count - 1 
      If UCase(SortSheets(j).name) > UCase(SortSheets(j + 1).name) Then 
      SortSheets(j).Move after:=SortSheets(j + 1) 
     End if 

    Next j 
End Sub