Блог

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

Перемотав вперед примерно на месяц, я понял, что в своей рабочей книге я забыл запись дочерней ячейки и добавил ее на все листы в рабочей книге. Проблема теперь в том, что макрос не будет окрашивать эту новую дочернюю ячейку. Мой код можно увидеть ниже, я специально сделал .Range("C1:K75") его достаточно большим , чтобы учитывать любые новые дочерние ячейки, поэтому я не думаю, что в этом проблема. Другая дочерняя ячейка с тем же текстом уже существовала в книге в другом месте, и я скопировал вставленный текст из родительской ячейки и исходной дочерней ячейки, чтобы убедиться, что текст точно соответствует. Исходная дочерняя ячейка будет окрашена, но, но новая дочерняя ячейка все равно не будет. Я поискал в Интернете информацию о коде vba, учитывающем новые ячейки, но, похоже, ничего не нашел. Никаких кодов ошибок не появляется или что-то в этом роде, он просто не будет окрашиваться в этой ячейке, как будто его там даже нет. Любая помощь будет признательна.

 Sub MatchAll()

'This will match the color of documents in the Job Description Reqs. to the color
'of the documents in the documents list, color in document on the list on the left side,
'run the macro, and it should make all the same documents in the sheet the same color

    Dim c As Range, r As Range, i As Long
    Dim sDocument As String

    With ActiveSheet
        For i = 8 To 200                         'Runs the macro for every cell
            Set r = .Range("A" amp; i)              'from A8:A200
            sDocument = CStr(r.Value)            'name of document you are looking for is now equal to name in document list
            If Not sDocument = vbNullString Then                 'if the cell in the document list is not blank then
                With .Range("C1:K75")                            'within the range of the Job Description Reqs.
                    Set c = .Find(sDocument, LookIn:=xlValues)   'look for the name of document stated in document list
                    If Not c Is Nothing Then                                    'if a document within the range of Job Description Reqs. is found
                        If Not c.Interior.Color = r.Interior.Color Then         'and the documents in both the list and Job Description Reqs. are not the same color
                            Do
                                c.Interior.Color = r.Interior.Color             'make the color of the Job Description Req. Document = the color of the list document
                                Set c = .FindNext(c)                            'find the next document listed in the Job Description Reqs,
                            Loop While Not c.Interior.Color = r.Interior.Color  'Repeat until all documents of that name are the same color
                        End If
                    End If
                End With
            End If
        Next i                                   'Move onto next document in document list and repeat
    End With
End Sub

 

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

 Sub MatchAll()

'This will match the color of documents in the Job Description Reqs. to the color
'of the documents in the documents list, color in document on the list on the left side,
'run the macro, and it should make all the same documents in the sheet the same color

    Dim c As Range, r As Range, i As Long
    Dim sDocument As String, sFirst As String

    With ActiveSheet
        For i = 8 To 200                         'Runs the macro for every cell
            Set r = .Range("A" amp; i)              'from A8:A200
            sDocument = CStr(r.Value)            'name of document you are looking for is now equal to name in document list
            If Not sDocument = vbNullString Then                 'if the cell in the document list is not blank then
                With .Range("C1:K75")                            'within the range of the Job Description Reqs.
                    Set c = .Find(sDocument, LookIn:=xlValues)   'look for the name of document stated in document list
                    If Not c Is Nothing Then     'if a document within the range of Job Description Reqs. is found
                        sFirst = c.Address       'and the documents in both the list and Job Description Reqs
                        Do
                            c.Interior.Color = r.Interior.Color             'make the color of the Job Description Req. Document = the color of the list document
                            Set c = .FindNext(c)                            'find the next document listed in the Job Description Reqs,
                        Loop While Not c.Address = sFirst  'Repeat until all documents of that name are the same color
                    End If
                End With
            End If
        Next i                                   'Move onto next document in document list and repeat
    End With
End Sub