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-коду.
Макрос написать минута времени
Можно, писать код