Top.Mail.Ru
Ответы

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

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

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

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

Аватар пользователя
Мыслитель
8мес

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

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

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

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

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

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

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

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

Аватар пользователя
Мудрец
8мес

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

Аватар пользователя
Ученик
8мес

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

Аватар пользователя
Ученик
8мес

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

Аватар пользователя
Ученик
8мес

каким образом?



Видео по теме