Top.Mail.Ru
Ответы
Аватар пользователя
Аватар пользователя
Аватар пользователя
Аватар пользователя
Информационные технологии
+4

EXCEL не дает копировать форматирование.

Привет, вопрос по экселю. На работе есть таблица с нормами, 4 колонки: норма жира, факт (кол-во жира) , норма белка, факт (кол-во белка) . в таблице 150 строк. самому превышение нормы в падлу отмечать заливкой, хотел сделать форматирование, мол если норма жира больше фактической то это желтый цвет, если белка меньше нормы тоже самое. в первой строке это работало, но после копирования, следующие ячейки так же ссылаются на нормы из первой строки. неужели нет возможности сделать это быстро и придется к каждой ячейке делать правило?

По дате
По рейтингу
Аватар пользователя
Ученик

Sub HighlightProteinAndFat_CorrectConditions()

Dim ws As Worksheet

Dim monthNames As Variant

Dim processedSheets As String

Dim lastRow As Long, i As Long

Dim sheetsFound As Boolean

' Все варианты названий месяцев

monthNames = Array("январь", "февраль", "март", "апрель", "май", "июнь", _

"июль", "август", "сентябрь", "октябрь", "ноябрь", "декабрь")

Application.ScreenUpdating = False

sheetsFound = False

processedSheets = ""

' Перебираем все листы в книге

For Each ws In ThisWorkbook.Worksheets

' Проверяем, совпадает ли название листа с любым месяцем (без учёта регистра)

If Not IsError(Application.Match(LCase(ws.Name), monthNames, 0)) Then

sheetsFound = True

lastRow = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row ' Считаем по столбцу "Норма белка" (C)

If lastRow > 150 Then lastRow = 150

' Обрабатываем данные со строки 2 (строка 1 - заголовки)

For i = 2 To lastRow

' ========== ПРОВЕРКА БЕЛКА ==========

' Только для непустых ячеек "факт. белок"

If Not IsEmpty(ws.Cells(i, 4)) And ws.Cells(i, 4).Value <> 0 Then

' Выделяем если факт < нормы (белка не хватает)

If ws.Cells(i, 4).Value < ws.Cells(i, 3).Value Then

ws.Cells(i, 4).Interior.Color = RGB(255, 255, 0) ' Жёлтый

Else

ws.Cells(i, 4).Interior.ColorIndex = xlNone

End If

Else

ws.Cells(i, 4).Interior.ColorIndex = xlNone

End If

' ========== ПРОВЕРКА ЖИРА ==========

' Только для непустых ячеек "факт. жир"

If Not IsEmpty(ws.Cells(i, 6)) And ws.Cells(i, 6).Value <> 0 Then

' Выделяем если факт > нормы (жира переизбыток)

If ws.Cells(i, 6).Value > ws.Cells(i, 5).Value Then

ws.Cells(i, 6).Interior.Color = RGB(255, 255, 0) ' Жёлтый

Else

ws.Cells(i, 6).Interior.ColorIndex = xlNone

End If

Else

ws.Cells(i, 6).Interior.ColorIndex = xlNone

End If

Next i

processedSheets = processedSheets & vbCrLf & ws.Name

End If

Next ws

Application.ScreenUpdating = True

If sheetsFound Then

MsgBox "Обработка завершена для:" & processedSheets & vbCrLf & vbCrLf & _

"Критерии выделения:" & vbCrLf & _

"🔸 Факт.белок: выделен если МЕНЬШЕ нормы" & vbCrLf & _

"🔸 Факт.жир: выделен если БОЛЬШЕ нормы" & vbCrLf & _

"🔸 Пустые ячейки никогда не выделяются", _

vbInformation, "Результат"

Else

MsgBox "Месячные листы не найдены!", vbExclamation

End If

End Sub

Аватар пользователя
Просветленный

в первой строке это работало

большая вероятность что в формуле вы "привязали" ячейку баксами. (=$F$7)

Снимите доллары.

если не получится - тогда покажите скриншот таблицы и скриншот УФ-а

Аватар пользователя
Оракул

Думаю, не обязательно делать правило на каждую ячейку. Нужно только продумать и аккуратно составить формулу для условного форматирования.

Например так:

Ссылка на файл по qr-коду.

Аватар пользователя
Оракул

Макрос написать минута времени

Аватар пользователя
Новичок

Можно, писать код