Koen的工作簿包含150个工作表，每个公司分支一个。他需要根据每个分支所属的区域对这些工作表进行排序。 （他的公司中有五个区域。）他还指出，如果每个工作表的选项卡颜色都可以反映该区域，那将是很好的，并且想知道在Excel中是否可以进行这种排序。

是的，这种排序是可能的，但是确实需要使用宏。

创建宏的最难的部分是定义如何确定哪个分支在哪个区域中。也许最简单的方法是确保您的工作表使用包含区域和分支信息的命名模式。例如，您可能将工作表命名为“ Reg01-Branch123”。然后，您的宏可以逐步浏览每个工作表，并进行着色和排序。

Sub SortWorksheets()

Dim iReg As Integer     Dim I As Integer     Dim J As Integer     Dim K As Integer     Dim ws As Worksheet

Application.ScreenUpdating = False

' Set tab colors     For Each ws in Worksheets         iReg = Val(Mid(ws.Name,4,2))

Select Case iReg             Case 1                 ws.Tab.Color = vbRed             Case 2                 ws.Tab.Color = vbYellow             Case 3                 ws.Tab.Color = vbBlue             Case 4                 ws.Tab.Color = vbGreen             Case 5                 ws.Tab.Color = vbCyan             Case Else                 ws.Tab.ColorIndex = xlColorIndexNone         End Select     Next ws

' Sort the worksheets     For I = 1 To Sheets.Count - 1         K = I         For J = I + 1 To Sheets.Count             If UCase(Sheets(K).Name) > UCase(Sheets(J).Name) Then K = J         Next J         If K <> I Then Sheets(K).Move Before:=Sheets(I)

Next I

Application.ScreenUpdating = True End Sub

该宏通过Worksheets集合工作两次。第一次通过时，将从工作表的名称中提取区域号。

然后使用它（在“选择案例”结构中）设置选项卡的颜色。

如果区域编号不在1-5的范围内，则选项卡的颜色不会更改。

如果您确定在哪个区域中的哪个分支更为复杂，则需要相应地调整宏。例如，您可能有一个名为“ Region Key”的工作表，该工作表在A列中包含每个分支的名称，在B列中包含每个分支的相应区域号。假设实际数据从第2行开始，则可以按以下方式修改宏：

Sub SortWorksheets2()

Dim sTemp As String     Dim iReg As Integer     Dim I As Integer     Dim J As Integer     Dim K As Integer     Dim ws As Worksheet     Dim key As Worksheet

Application.ScreenUpdating = False

Set key = Worksheets("Region Key")



' Set tab colors     For Each ws in Worksheets         sTemp = UCase(ws.Name)

I = 2    ' Beginning row number         iReg = 0         While key.Cells(I, 1) > ""

If UCase(key.Cells(I, 1)) = sTemp Then iReg = key.Cells(I, 2)

I = I + 1         Wend         Select Case iReg             Case 1                 ws.Tab.Color = vbRed             Case 2                 ws.Tab.Color = vbYellow             Case 3                 ws.Tab.Color = vbBlue             Case 4                 ws.Tab.Color = vbGreen             Case 5                 ws.Tab.Color = vbCyan             Case Else                 ws.Tab.ColorIndex = xlColorIndexNone         End Select     Next ws

' Sort the worksheets     For I = 1 To Sheets.Count - 1         K = I         For J = I + 1 To Sheets.Count             If UCase(Sheets(K).Name) > UCase(Sheets(J).Name) Then K = J         Next J         If K <> I Then Sheets(K).Move Before:=Sheets(I)

Next I     Sheets("Region Key").Move Before:=Sheets(1)



Application.ScreenUpdating = True End Sub

此宏与上一个宏的最大区别在于，该宏从工作表中获取区域号。作为宏中的最后一个动作，“区域键”工作表被移至工作表集合的最开始。

请注意，第二个宏也可能会在程序窗口底部显示工作表选项卡，看起来就像万花筒般的颜色。

原因是选项卡是根据其名称而不是根据其颜色排序的。这与第一个宏不同，第一个宏有效地按区域排序，然后按分支排序，因为工作表是使用该模式命名的。如果您仍要使用“区域键”

方法并按区域排序，然后分支，可以通过进一步调整宏来做到这一点：

Sub SortWorksheets3()

Dim sTemp As String     Dim sSortArray(499) As String     Dim iReg As Integer     Dim I As Integer     Dim J As Integer     Dim K As Integer     Dim ws As Worksheet     Dim key As Worksheet

Application.ScreenUpdating = False

Set key = Worksheets("Region Key")



' Set tab colors and build sort array     J = 0     For Each ws in Worksheets         sTemp = UCase(ws.Name)

I = 2    ' Beginning row number         iReg = 0         While key.Cells(I, 1) > ""

If UCase(key.Cells(I, 1)) = sTemp Then iReg = key.Cells(I, 2)

I = I + 1         Wend

J = J + 1         sSortArray(J) = Right("00" & iReg, 2) & " " & ws.Name

Select Case iReg             Case 1                 ws.Tab.Color = vbRed             Case 2                 ws.Tab.Color = vbYellow             Case 3                 ws.Tab.Color = vbBlue             Case 4                 ws.Tab.Color = vbGreen             Case 5                 ws.Tab.Color = vbCyan             Case Else                 ws.Tab.ColorIndex = xlColorIndexNone                 ' Force into incorrect region area for sort                 sSortArray(J) = "00 " & ws.Name         End Select     Next ws

' Sort the worksheets     For I = 1 To Sheets.Count - 1         K = I         For J = I + 1 To Sheets.Count             If UCase(sSortArray(K)) > UCase(sSortArray(J)) Then K = J         Next J         If K <> I Then             Sheets(K).Move Before:=Sheets(I)

sTemp = sSortArray(K)

For J = K To I Step -1                 sSortArray(J) = sSortArray(J-1)

Next J             sSortArray(I) = sTemp         End If     Next I     Sheets("Region Key").Move Before:=Sheets(1)



Application.ScreenUpdating = True End Sub

请注意，宏的此迭代依赖于一个辅助数组（sSortArray）来跟踪工作表中的名称应如何排序。

注意：

如果您想知道如何使用此页面（或_ExcelTips_网站上的任何其他页面）中描述的宏，我准备了一个特殊页面，其中包含有用的信息。

点击此处在新的浏览器标签中打开该特殊页面。

_ExcelTips_是您进行经济高效的Microsoft Excel培训的来源。

本提示（13710）适用于Microsoft Excel 2007、2010、2013、2016、2019和Office 365中的Excel。