Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Подсчет ячеек с шрифтом определённого цвета
 
#1
31.10.2016 13:59:23
Здравствуйте товарищи. Помогите решить задачку. Появилась необходимость проанализировать старые учетные данные, данные в ячейках различаются цветом шрифта. Написал небольшой макрос чтоб подсчитывал количество ячеек с шрифтом определённого цвета в выделенной области. Всё работает пока не натыкается на ячейку где шрифт выделен двумя разными цветами. Выдаёт ошибку "run-time 94. Invalid use of Null". Не знаю как побороть.
Вот сам код:
Код
Sub ПроверкаЖурналаЗаявок()

    Dim rngX As Range
    Dim c As Range
    Dim i As Integer
    Dim iM As Integer
    Dim iP As Integer
    Dim colF As Double

    
Set rngX = Selection
Set c = rngX.Cells

    i = 0
    iM = 0
    iP = 0
    
    For Each c In rngX
        If c.Value <> "" Then
            i = i + 1
            colF = c.Font.Color
            If colF = 1842204 Or colF = 1118481 Or colF = 0 Then
                iM = iM + 1
            End If
            If colF = 255 Or colF = 204 Then
                iP = iP + 1
            End If
        End If
    Next c
    
    Debug.Print "всего "; i
    Debug.Print "выход мех."; iM
    Debug.Print "простоев"; iP
    
    i = i - iM - iP
    
    Debug.Print "аварийка"; i

End Sub
Если нужен сам файлик, тоже сброшу.
 
 
 
#2
31.10.2016 14:08:15
Цитата
на ячейку где шрифт выделен двумя разными цветами
Видимо надо анализировать цвет каждого символа в ячейке
 
 
 
#3
31.10.2016 14:16:42
Код
Option Explicit

Sub ПроверкаЖурналаЗаявок()
 
    Dim rngX As Range
    Dim c As Range
    Dim i As Integer
    Dim iM As Integer
    Dim iP As Integer
    Dim iMandP As Integer
    Dim colF As Double
    Dim j As Integer
    Dim bM As Boolean
    Dim bP As Boolean
     
Set rngX = Selection
Set c = rngX.Cells
 
    i = 0
    iM = 0
    iP = 0
    iMandP = 0
     
    For Each c In rngX
        If c.Value <> "" Then
            i = i + 1
            
            bM = False
            bP = False
            With c
                For j = 1 To Len(c.Text)
                   Select Case .Characters(Start:=j, Length:=1).Font.Color
                   Case 1842204, 1118481, 0
                    bM = True
                   Case 255, 204
                    bP = True
                   End Select
                Next j
            End With
            
            If bM Then iM = iM + 1
            If bP Then iP = iP + 1
            If bM And bP Then iMandP = iMandP + 1
        End If
    Next c
     
    Debug.Print "всего "; i
    Debug.Print "выход мех."; iM
    Debug.Print "простоев"; iP
     
    i = i - iM - iP + iMandP
     
    Debug.Print "аварийка"; i
 
End Sub
 
 
 
Страницы: 1
Наверх