Вкладка «Рабочая книга» Цикл подсчета цветов

Вам нужно использовать переменную, для которой установлено значение 0 вне вашего цикла. Тогда вместо того, чтобы просто считать табуляцию (которая всегда будет равна 1 или 0, как вы это написали), вам нужно добавить 1 к переменной. Затем, проходя по всем вашим листам, переменная будет изменена на количество листов, которые вызывают TRUE для вашего условия IF.

Итак, чтобы уточнить: сначала вы говорите x = 0, затем начинаете перебирать свои листы, и каждый раз, когда он видит вкладку с этим цветом, он переопределяет x как x + 1, в противном случае оно останется предыдущим значением. Затем, после прохождения, он эффективно подсчитает все цветные вкладки и выдаст вам счетчик в ближайшем окне окна VBA. Вы можете изменить его на поле сообщения или значение ячейки.

Dim x as Long
x = 0
For Each mysheet in ActiveWorkbook.sheets
     If mysheet.tab.color = RGB(255,0,0) then
        x = x + 1 
     End If
Next mysheet

Debug.Print x

End Sub

Если вам нужно сделать это для более чем одного цвета, вы можете добавить новый блок, используя новую переменную или даже ту же переменную, если вы сбросите значение обратно на 0 и напечатаете где-нибудь предыдущий счетчик (в противном случае вы бы не сделали этого). знать счет).

Dim x as Long, y as long, z as long

x = 0
For Each mysheet in ActiveWorkbook.sheets
     If mysheet.tab.color = RGB(255,0,0) then
        x = x + 1 
     End If
Next mysheet

y = 0
For Each mysheet in ActiveWorkbook.sheets
     If mysheet.tab.color = RGB(255,255,0) then
        y = y + 1 
     End If
Next mysheet

Debug.Print x

End Sub

В качестве альтернативы вы можете создать условие ELSEIF для обработки его с помощью единой логики. Это то, что я бы рекомендовал, если вы знаете, какими будут ваши цвета, и они не будут меняться, в противном случае вам может потребоваться отредактировать это в этом случае. возможно, стоит создать переменную для разных цветов в одном месте, чтобы вы могли легко ее поддерживать или использовать где-то ссылку для дальнейшей автоматизации:

Dim x as Long, y as long, z as long

x = 0
y = 0
z = 0
For Each mysheet in ActiveWorkbook.sheets
     If mysheet.tab.color = RGB(255,0,0) then
             x = x + 1 
         ElseIf mysheet.tab.color = RGB(255,255,0) then
             y = y + 1
         ElseIf mysheet.tab.color = RGB(0,255,0) then
             z = z + 1
     End If
Next mysheet

'Print x, y, & z somewhere for results

End Sub

Количество цветов вкладки списка

• Лучше всего проверить копию своей рабочей тетради, прежде чем знакомиться с ней. Он будет записывать на первый (самый левый) лист. Лучше используйте имя (например, "Sheet1") вместо индекса (1) при ссылке на него (dws).

Sub ListTabColors()

    Dim Headers() As Variant:
    Headers = VBA.Array("ID", "ColorNum", "Color", "Count")

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim dws As Worksheet: Set dws = wb.Worksheets(1) ' improve!
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    
    Dim ssh As Object, Color As Long
    
    For Each ssh In wb.Sheets
        Color = ssh.Tab.Color
        dict(Color) = dict(Color) + 1
    Next ssh
            
    Dim drCount As Long: drCount = dict.Count + 1
    Dim dcCount As Long: dcCount = UBound(Headers) + 1
    Dim drg As Range: Set drg = dws.Range("A2").Resize(drCount, dcCount)
    Dim Data() As Variant: ReDim Data(1 To drCount, 1 To dcCount)
    Dim r As Long: r = 1
    
    dws.UsedRange.Clear
    
    Dim Key As Variant, c As Long
    
    For c = 1 To dcCount
        Data(1, c) = Headers(c - 1)
    Next c
    
    For Each Key In dict.Keys
        r = r + 1
        Data(r, 1) = r - 1
        Data(r, 2) = Key
        drg.Cells(r, 3).Interior.Color = Key
        Data(r, 4) = dict(Key)
    Next Key
    
    With drg
        .Value = Data
        .Rows(1).Font.Bold = True
        .EntireColumn.AutoFit
    End With
     
    With dws.Range("A1")
        .Value = "Tab Colors"
        With .Font
            .Bold = True
            .Size = 14
        End With
    End With
    
    MsgBox "Tab colors count listed.", vbInformation
     
End Sub

Цвет листа Tab может иметь числовое значение, ссылающееся на фактический цвет вкладки, или логическое значение, которое указывает, что индекс цвета установлен на xlColorIndexNone.

Sub tab_color()

For each ws in Worksheets

if TypeName(ws.Tab.Color) = "Boolean" then
  nocolor=nocolor+1
end if

next ws

Msgbox "Count of no colored tabs: " & nocolor

End Sub