#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. Ты, как всегда, лучший Тим. Большое вам спасибо, хорошего дня, работает даже быстрее, чем предыдущий. Нет условного форматирования, только простая раскраска. Еще раз спасибо!