касательно копирования формата строк

[Volodymyr]

добрый день!
в одной из тем рассматривали Условное форматирование средствами VBA.
http://programmersforum.ru/showthrea...F2%F0%EE%EA%E8

А как быть, если необходимо не только закрасить строчку в зависимости от условия, а также еще присвоить формат каждой ячейке этой строки. К примеру 1 ячейка – формат даты, 2-я –текст, 3- число?

Спасибо за помощь,
Владимир.

[EducatedFool]

в одной из тем рассматривали Условное форматирование средствами VBA

Это обсужалось во многих темах. И что из этого?
Где Ваша задача (вместе с прикреплённым файлом)?
Что и как надо реализовать?

также еще присвоить формат каждой ячейке этой строки

Это одна строчка кода.
Например:

Sheets(L).Cells(d + 1, "I").NumberFormat = "General" ' общий
Range("D1").NumberFormat = "#,##0.00$" ' денежный
cells(1, 1).NumberFormat = "@" ' текстовый
[e2].NumberFormat = "dd/mm/yy" ' дата

[Volodymyr]

Вот пример файла.
Задача сводится к следующему: в зависимости от названия фирмы в столбце AD, необходимо перекрасить всю строчку в уникальный для это компании цвет, при этом необходимо, чтобы формат каждой ячейки был тоже скопирован в зависимости от того, что находится в этой ячейке (текст, дата, число).
С уважением, Владимир.

[EducatedFool]

С такой формулировкой задания я Вам помочь не смогу.

необходимо перекрасить всю строчку в уникальный для это компании цвет

откуда я знаю, какой цвет соответствует каждой компании?

при этом необходимо, чтобы формат каждой ячейки был тоже скопирован в зависимости от того, что находится в этой ячейке

что и куда копировать?
и зачем? один раз назначили нужный формат ячейкам, и всё.
(ведь в каждом столбце будут присутствовать данные одного типа, разве не так?)

Может, кто из форумчан и сможет прочитать Ваши мысли, но я вряд ли...

[Volodymyr]

Упрек понял.
Действительно, формат ячеек будет одинаковый для всех компаний, т.е. столбцы ”A-F” – текстовые, “G-I” – числовые, “J-AD” – числовые.

Цвета для компаний следующие:
Фирма1 – желтый
Фирма2 – красный
Фирма3 – синий
Фирма4 – зеленый
Фирма5 – оранжевый
Фирма7 – салатовый
, т.е. какой оттенок – не принципиально.

А задача сводится к тому, чтобы после запуска макроса, таблица форматировалась согласно формату, который был описан выше, а в зависимости от названия компании в столбце AD, строки перекрашивались в цвет согласно таблице выше.

Спасибо за помощь,
Володя.

[EducatedFool]

Попробуйте так:

Sub Main()
    Application.ScreenUpdating = False
    Dim sh As Worksheet: Set sh = ActiveSheet: Dim cell As Range
    sh.UsedRange.Offset(1).Interior.ColorIndex = 0    ' очистка цвета
    Dim ra As Range: Set ra = Intersect(sh.UsedRange.Offset(1), sh.Columns("AD"))
    For Each cell In ra.Cells
        Select Case Trim(cell.Value)
            Case "Фирма1": cell.EntireRow.Interior.ColorIndex = 36
            Case "Фирма2": cell.EntireRow.Interior.ColorIndex = 38
            Case "Фирма3": cell.EntireRow.Interior.ColorIndex = 37
            Case "Фирма4": cell.EntireRow.Interior.ColorIndex = 35
            Case "Фирма5": cell.EntireRow.Interior.ColorIndex = 40
            Case "Фирма6": cell.EntireRow.Interior.ColorIndex = 39
            Case "Фирма7": cell.EntireRow.Interior.ColorIndex = 41
            Case Else:    ' ничего не делаем
        End Select
    Next
End Sub

[Volodymyr]

спасибо EducatedFood за Ваш пример. Он работает правильно и быстро. Я написал подобный макрос через Case. Прошу Вас также подсказать, как вначале макроса отформатировать столбцы под разные значения (дата, число, текст).

С уважением, Владимир.

[EducatedFool]

Ну как-то так:

Sub Main2()
    Application.ScreenUpdating = False
    Dim sh As Worksheet: Set sh = ActiveSheet
    
    Intersect(sh.UsedRange.Offset(1), sh.Range("A:f")).NumberFormat = "@"
    Intersect(sh.UsedRange.Offset(1), sh.Range("g:i")).NumberFormat = "0.000"
    Intersect(sh.UsedRange.Offset(1), sh.Range("J:AD")).NumberFormat = "0.00"
End Sub

[Volodymyr]

Спасибо, Вы очень оперативны.
Тогда я задам Вам еще 1 вопрос: а можно ли, чтобы заливка строк заканчивалась на столбце AD?

[EducatedFool]

Option Compare Text

Sub Main()
    Application.ScreenUpdating = False
    Dim sh As Worksheet: Set sh = ActiveSheet: Dim cell As Range
    sh.UsedRange.Offset(1).Interior.ColorIndex = 0    ' очистка цвета
    Dim ra As Range: Set ra = Intersect(sh.UsedRange.Offset(1), sh.Columns("AD"))
    For Each cell In ra.Cells
        Select Case Trim(cell.Value)
            Case "Фирма1": Index = 36
            Case "Фирма2": Index = 38
            Case "Фирма3": Index = 37
            Case "Фирма4": Index = 35
            Case "Фирма5": Index = 40
            Case "Фирма6": Index = 39
            Case "Фирма7": Index = 41
            Case Else: Index = 0
        End Select
        Intersect(cell.EntireRow, sh.Range("a:ad")).Interior.ColorIndex = Index
    Next
End Sub