У меня есть люди, чье рабочее время показано условным форматированием в ячейках их собственных столбцов - например, B7: B36, C7: C36, D7: D36 и так далее. Я пытаюсь подсчитать ячейки условного форматирования в столбце E. Конечным результатом в ячейке является #Value (Arvo), но когда вы нажимаете F9, тогда цифры могут отображаться.

Когда я запускаю код шаг за шагом, я заметил, что после строкиСпектр("B6", ws.Cells.SpecialCells (xlCellTypeLastCell)). Программа ClearFormats позволяет перейти к функции "Функция CountRed (MyRange As Range » и оставаться в петле в течение некоторого времени.

Это потому что есть функция "CountRed (В6) + CountGreen (С6) + CountBlue (Д6)» например в ячейке е6?

Кроме того, я хотел бы, чтобы номера столбцов в столбце E были сосредоточены в центре.

Ошибка, если время выхода пусто:

Результат с ошибкой в столбце E:

Результаты должны выглядеть так:

Оригинальный код также можно найтиВот - Спасибо, Флорис!

Option Explicit
Private Sub worksheet_change(ByVal target As Range)

If Not Intersect(target, Range("B4:Q4")) Is Nothing Then

 'Sub makeTimeGraph()
    Dim startRow As Long
    Dim endRow As Long
    Dim entryTimeRow As Long
    Dim entryTimeFirstCol As Long
    Dim Applicaton
    Dim ws As Excel.Worksheet
    Dim timeRange As Range
    Dim c
    Dim timeCols As Range
    Dim entryTime
    Dim exitTime
    Dim formatRange As Excel.Range
    Dim eps
    eps = 0.000001 ' a very small number - to take care of rounding errors in lookup
    Dim entryName
    Dim Jim
    Dim Mark
    Dim Lisa
    Dim nameCols As Range

    ' change these lines to match the layout of the spreadsheet
    ' first cell of time entries is B4 in this case:
    entryTimeRow = 4
    entryTimeFirstCol = 2
    ' time slots are in column A, starting in cell A6:
    Set timeRange = Range("A6", [A6].End(xlDown))

    ' columns in which times were entered:
    Set ws = ActiveSheet
    Set timeCols = Range("B4:Q4") ' select all the columns you want here, but only one row
    Set nameCols = Range("B3:Q3") ' columns where the names are in the third row

    ' clear previous formatting
    Range("B6", ws.Cells.SpecialCells(xlCellTypeLastCell)).ClearFormats

    Application.ScreenUpdating = False

    ' loop over each of the columns:
    For Each c In timeCols.Cells

      Application.StatusBar = entryName
      If IsEmpty(c) Then GoTo nextColumn

      entryTime = c.Value
      exitTime = c.Offset(1, 0).Value
      entryName = c.Offset(-1, 0).Value

      startRow = Application.WorksheetFunction.Match(entryTime + eps, timeRange) + timeRange.Cells(1.1).Row - 1
      endRow = Application.WorksheetFunction.Match(exitTime - eps, timeRange) + timeRange.Cells(1.1).Row - 1
      Set formatRange = Range(ws.Cells(startRow, c.Column), ws.Cells(endRow, c.Column))

      'select format range
      formatRange.Select


      ' select name for coloring
      Select Case entryName

        Case "Jim"
            Call formatTheRange1(formatRange)    ' Red  Colorinex 3

        Case "Mark"
            Call formatTheRange2(formatRange)   ' Green Colorindex 4

        Case "Lisa"
            Call formatTheRange3(formatRange)    ' Blue Colorindex 5

    End Select

nextColumn:
    Next c
End If
Range("A1").Activate
Application.ScreenUpdating = True

End Sub

Private Sub formatTheRange1(ByRef r As Excel.Range)

       r.HorizontalAlignment = xlCenter
       r.Merge

          ' Apply color red coloroindex 3
          With r.Interior
             .Pattern = xlSolid
             .ColorIndex = 3
             '.TintAndShade = 0.8
             Selection.UnMerge
         End With

End Sub

Private Sub formatTheRange2(ByRef r As Excel.Range)

         r.HorizontalAlignment = xlCenter
         r.Merge

          ' Apply color  Green Colorindex 4
          With r.Interior

             .Pattern = xlSolid
             .ColorIndex = 4
             '.TintAndShade = 0.8
                 Selection.UnMerge
         End With

End Sub

Private Sub formatTheRange3(ByRef r As Excel.Range)

         r.HorizontalAlignment = xlCenter
         r.Merge

          ' Apply color  Blue Colorindex 5
          With r.Interior

             .Pattern = xlSolid
             .ColorIndex = 5
           '.TintAndShade = 0.8
               Selection.UnMerge
         End With

End Sub

Function CountRed(MyRange As Range)
    Dim i As Integer
    Application.Volatile
    i = 0
    For Each cell In MyRange
        If cell.Interior.ColorIndex = 3 Then
            i = i + 1
        End If
    Next cell
    CountRed = i
End Function

Function CountGreen(MyRange As Range)
    Dim i As Integer
    Application.Volatile
    i = 0
    For Each cell In MyRange
        If cell.Interior.ColorIndex = 4 Then
            i = iCount + 1
        End If
    Next cell
    CountGreen = i
End Function

Function CountBlue(MyRange As Range)
    Dim i As Integer
    Application.Volatile
    i = 0
    For Each cell In MyRange
        If cell.Interior.ColorIndex = 5 Then
            i = i + 1
        End If
    Next cell
    CountBlue = i
End Function