Sub HighlightMinValueInRows()

    Dim ws As Worksheet

    Set ws = ActiveSheet

   

    Dim lastRow As Long

    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row

   

    Dim searchText As String

    searchText = "ИТОГО с учетом индексации и курсов валют с НДС 22%"

   

    Dim r As Long

    Dim c As Long

    Dim minVal As Variant

    Dim minCell As Range

    Dim lastCol As Long

   

    Application.ScreenUpdating = False

   

    For r = 1 To lastRow

        ' Проверяем, соответствует ли ячейка в столбце C искомому тексту

        If ws.Cells(r, "C").Value = searchText Then

            ' Определяем последний заполненный столбец в текущей строке

            lastCol = ws.Cells(r, ws.Columns.Count).End(xlToLeft).Column

           

            minVal = Nothing

            Set minCell = Nothing

           

            For c = 1 To lastCol

                Dim cellValue As Variant

                cellValue = ws.Cells(r, c).Value

               

                ' Проверяем, что значение числовое

                If IsNumeric(cellValue) Then

                    ' Преобразуем в число для сравнения

                    Dim numVal As Double

                    numVal = CDbl(cellValue)

                   

                    If IsEmpty(minVal) Or numVal < minVal Then

                        minVal = numVal

                        Set minCell = ws.Cells(r, c)

                    End If

                End If

            Next c

           

            ' Если минимальное число найдено — выделяем ячейку жёлтым

            If Not minCell Is Nothing Then

                minCell.Interior.Color = vbYellow

            End If

        End If

    Next r

   

    Application.ScreenUpdating = True

   

    MsgBox "Готово! Минимальные значения выделены жёлтым.", vbInformation

End Sub