按字母順序排序後按顏色排序

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