У Коэна есть рабочая тетрадь, содержащая 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. При первом проходе номер региона извлекается из имени рабочего листа.

Затем он используется (в структуре Select Case) для установки цвета вкладки.

Если номер региона находится за пределами диапазона от 1 до 5, цвет вкладки не изменяется.

Если ваше определение того, какая ветвь в каком регионе более сложна, вам необходимо соответствующим образом настроить макрос. Например, у вас может быть рабочий лист с именем «Ключ региона», который содержит в столбце 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), я подготовил специальную страницу, содержащую полезную информацию.

link: / excelribbon-ExcelTipsMacros [Щелкните здесь, чтобы открыть эту специальную страницу в новой вкладке браузера].

ExcelTips — ваш источник экономичного обучения Microsoft Excel.

Этот совет (13710) применим к Microsoft Excel 2007, 2010, 2013, 2016, 2019 и Excel в Office 365.