Excel VBA: найдите значения и вставьте только цвета (проблема без цвета)

#excel #vba #colors #match

#excel #vba #Цвет #совпадение

Вопрос:

долгое время не видел. Я имею дело с небольшой задачей, которую я почему-то не могу понять. У меня есть огромный лист Excel (около 4000 строк), который разделяется и отправляется людям — они отмечают желтые или красные ячейки из столбца K в столбец T в определенной строке и отправляют его обратно каждую неделю, пока диапазон от K до T в этих 4000 строках не будет иметь значение «X»(значение отправлено) помечены желтым или красным цветом (получено обратно или не получено). Лист Excel имеет уникальное значение в столбце J (поэтому я использую MATCH). Итак, используя этот столбец J, я просматриваю каждую строку в данных (основной лист) и проверяю, найдено ли это на листе ввода (что-то, что было возвращено пользователями), если оно найдено, я иду и копирую цвет их маркировки в исходный лист данных. Это отлично работает как шарм для этих желтых и красных цветов, сам модуль работает быстро — просто интересно, нет ли ошибок (последний раз, когда я делал некоторые макросы, было 3 года назад).). Проблема — если ячейка пуста, она вставляется как БЕЛАЯ обратно в таблицу данных, а исходная сетка Excel исчезает (трудно читается). Кто-нибудь может указать мне правильное направление? Спасибо!

 Sub test4()
Application.ScreenUpdating = False
Set dat = Sheets("Data")
n = dat.Range("J" amp; Rows.Count).End(xlUp).Row

Dim test As Long
For i = 2 To n
    inputrow = 0
    On Error Resume Next
    inputrow = Application.WorksheetFunction.Match(Worksheets("Data").Range("J" amp; i).Value, Sheets("Input").Range("J:J"), 0)
    On Error GoTo 0
    If inputrow > 0 Then
o = dat.Range("A" amp; Rows.Count).End(xlUp).Row   1
        dat.Range("K" amp; i).Interior.Color = Sheets("Input").Range("K" amp; inputrow).DisplayFormat.Interior.Color
        dat.Range("L" amp; i).Interior.Color = Sheets("Input").Range("L" amp; inputrow).DisplayFormat.Interior.Color
        dat.Range("M" amp; i).Interior.Color = Sheets("Input").Range("M" amp; inputrow).DisplayFormat.Interior.Color
        dat.Range("N" amp; i).Interior.Color = Sheets("Input").Range("N" amp; inputrow).DisplayFormat.Interior.Color
        dat.Range("O" amp; i).Interior.Color = Sheets("Input").Range("O" amp; inputrow).DisplayFormat.Interior.Color
        dat.Range("P" amp; i).Interior.Color = Sheets("Input").Range("P" amp; inputrow).DisplayFormat.Interior.Color
        dat.Range("Q" amp; i).Interior.Color = Sheets("Input").Range("Q" amp; inputrow).DisplayFormat.Interior.Color
        dat.Range("R" amp; i).Interior.Color = Sheets("Input").Range("R" amp; inputrow).DisplayFormat.Interior.Color
        dat.Range("S" amp; i).Interior.Color = Sheets("Input").Range("S" amp; inputrow).DisplayFormat.Interior.Color
        dat.Range("T" amp; i).Interior.Color = Sheets("Input").Range("T" amp; inputrow).DisplayFormat.Interior.Color
    End If
Next i

End Sub
 

Комментарии:

1. Я предполагаю, что вы могли бы проверить, если DisplayFormat.Interior.Color = xlNone (непроверенный).

2. DisplayFormat.Interior.ColorIndex = xlNone будет иметь значение True, если ячейка не была окрашена. Если вы не работаете с условным форматированием, вам не нужно DisplayFormat

3. Здравствуйте @BigBen amp; Tim — не могли бы вы показать мне, как я должен изменить код, чтобы он не копировал пустые ячейки в «белые»? Это функция IF? Это было бы много, если 🙂 Спасибо!

Ответ №1:

DisplayFormat.Interior.ColorIndex = xlNone будет иметь значение True, если ячейка не была окрашена. Если вы не работаете с условным форматированием, вам не нужно DisplayFormat

 Sub test4()
    Dim test As Long, inputrow, dat As Worksheet, wsInput As Worksheet
    Dim n As Long, i As Long, c As Long, o
    
    Application.ScreenUpdating = False
    
    Set wsInput = Sheets("Input")
    Set dat = Sheets("Data")
    
    n = dat.Range("J" amp; Rows.Count).End(xlUp).Row
    
    For i = 2 To n
        
        inputrow = Application.Match(dat.Range("J" amp; i).Value, wsInput.Range("J:J"), 0)
        
        If Not IsError(inputrow) Then 'check for match
            o = dat.Range("A" amp; Rows.Count).End(xlUp).Row   1
            'loop over columns
            For c = 11 To 20
                With wsInput.Rows(inputrow).Cells(c)
                    'copy color if cell is not default color
                    If .Interior.ColorIndex <> xlNone Then
                        dat.Cells(i, c).Interior.Color = .Interior.Color
                    End If
                End With
            Next c
        End If 'got match
    Next i
End Sub
 

Комментарии:

1. Ты, как всегда, лучший Тим. Большое вам спасибо, хорошего дня, работает даже быстрее, чем предыдущий. Нет условного форматирования, только простая раскраска. Еще раз спасибо!