Как создать макрос в один клик для цветовых кодовых вкладок на основе содержимого имени листа? - PullRequest
1 голос
/ 12 октября 2019

У меня есть макрос для импорта нескольких файлов на один лист и присвоения им имен с допустимыми символами. Эти файлы и имена файлов будут время от времени меняться в зависимости от потребностей проекта. Я хотел бы раскрасить код, как листы, по названию листа.

Поэтому мне нужно перебрать все листы в поисках определенных фраз. Как и все листы, содержащие слово «страница» будут окрашены в синий цвет. Таким образом, дубликаты заголовков страниц и слишком длинные заголовки страниц будут синими вкладками. Хотя страницы, содержащие фразу H1, будут красными. Таким образом, дубликаты H1 и H1 Too Long были бы красными вкладками.

Бывают случаи, когда заголовок включает в себя как страницу, так и H1, поэтому мне нужно сделать исключение для этого и выбрать уникальный цвет.

Я понимаю, что мне нужно пройтись по всем листам, проверяя их наличие и давая пример того, что содержит имя и какой цвет я хочу использовать, но мне не удается найти макрос в один клик, который нечастный саб для выполнения этого.

Sub TabColor()

Sheets("canonicals missing").Tab.Color = vbBlack
Sheets("canonicals nonindexable canonic").Tab.Color = vbBlack
Sheets("h1 duplicate").Tab.Color = vbRed
Sheets("h1 missing").Tab.Color = vbRed
Sheets("h1 multiple").Tab.Color = vbRed
Sheets("h1 over 70 characters").Tab.Color = vbRed
Sheets("page titles duplicate").Tab.Color = vbBlue
Sheets("page titles missing").Tab.Color = vbBlue
Sheets("page titles over 65 characters").Tab.Color = vbBlue
Sheets("page titles same as h1").Tab.Color = vbBlue

End Sub

Я выбрал точный маршрут заголовка, потому что иногда они содержат два ключевых слова, таких как «страница» и «h1», поэтому я решил, что лучше быть явным. Однако, если эти названия не существуют, то это останавливается. Заголовки всегда будут различаться, поэтому невозможно точно определить, какими будут заголовки в любом пакете файлов .xls. Я понятия не имею, как перебрать каждый лист и проверить его существование. Я очень плохо знаком с VBA и спотыкаюсь.

Ответы [ 3 ]

0 голосов
/ 12 октября 2019

Вот метод, который окрашивает вкладки в зависимости от цвета фона ячеек в индексной таблице. Преимущество этого подхода в том, что вы можете легко изменять текст поиска и цвета. Анимированный GIF (нажмите для подробного просмотра) показывает, что я пошагово прошёл код и раскрасил вкладки листа на основе текста в цветных ячейках. Конечно, вы бы изменили код в соответствии со своими потребностями.

enter image description here

Sub colorTabs()
Dim sh As Worksheet, r As Range
Set sh = ThisWorkbook.Worksheets("index")
Set r = sh.Range("A1")
While r <> ""
    For Each sh In ThisWorkbook.Worksheets
        If InStr(sh.Name, r) Then sh.Tab.ColorIndex = r.Interior.ColorIndex
    Next sh
    Set r = r.Offset(1, 0)
Wend
End Sub
0 голосов
/ 12 октября 2019

Когда вы раскрасили вкладки, которые не содержат page или H1 в vbBlack в вашем примере, я предполагаю, что вы ищете что-то подобное

Sub ColorIt()

    Dim wks As Worksheet

    For Each wks In ActiveWorkbook.Worksheets

        ' Black for all sheets
        wks.Tab.Color = vbBlack

        ' Blue in case it contains 'page'
        If InStr(1, wks.Name, "page") Then
            wks.Tab.Color = vbBlue
        End If

        ' Red in case it contains 'H1'
        If InStr(1, wks.Name, "H1") Then
            wks.Tab.Color = vbRed
        End If

        ' Cyan (or another color) in case it contains 'page' and 'H1'
        If InStr(1, wks.Name, "page") > 0 And InStr(1, wks.Name, "H1") > 0 Then
            wks.Tab.Color = vbCyan
        End If

    Next wks

End Sub
0 голосов
/ 12 октября 2019

Может быть, как-то так?

Использование a для каждого цикла в коллекции worksheets и instr для поиска строки в строке.

Sub test_tabcol()

Dim w As Excel.Worksheet

For Each w In ThisWorkbook.Worksheets

    If InStr(1, w.Name, "search for blue", vbTextCompare) <> 0 Then
        w.Tab.Color = vbBlue
    ElseIf InStr(1, w.Name, "search for red", vbTextCompare) <> 0 Then
        w.Tab.Color = vbRed
    Else
        w.Tab.Color = xlNone
    End If

Next w

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...