В файле есть столбец "А" с Часами, и столбец "С" с сменами. Задача состоит в том, чтобы в столбце "А" ячейки принимали значения столбца "С" только в том случае, если они одинакового цвета. Например, ячейка, содержащая значение "4", должна быть заменена на значение 7:00 - 11:00, т.к. у этих ячеек одинаковый цвет. Надеюсь понятно изложил.
Заранее спасибо.
Доброго времени суток.
В файле есть столбец "А" с Часами, и столбец "С" с сменами. Задача состоит в том, чтобы в столбце "А" ячейки принимали значения столбца "С" только в том случае, если они одинакового цвета. Например, ячейка, содержащая значение "4", должна быть заменена на значение 7:00 - 11:00, т.к. у этих ячеек одинаковый цвет. Надеюсь понятно изложил.
Sub clr() lr1 = Cells(Rows.Count, 1).End(xlUp).Row lr2 = Cells(Rows.Count, 3).End(xlUp).Row For i = 2 To lr1 For j = 2 To lr2 If Cells(i, 1).Interior.Color = Cells(j, 3).Interior.Color Then Cells(i, 1).Value = Cells(j, 3).Value Next j, i End Sub
[/vba]
Прямо в лоб. [vba]
Код
Sub clr() lr1 = Cells(Rows.Count, 1).End(xlUp).Row lr2 = Cells(Rows.Count, 3).End(xlUp).Row For i = 2 To lr1 For j = 2 To lr2 If Cells(i, 1).Interior.Color = Cells(j, 3).Interior.Color Then Cells(i, 1).Value = Cells(j, 3).Value Next j, i End Sub
Sub clr() Dim lr&, i&, rng As Range lr = Cells(Rows.Count, "AN").End(xlUp).Row For Each rng In Range("A1").CurrentRegion For i = 2 To lr If rng.Interior.Color = Cells(i, "AN").Interior.Color Then rng.Value = Cells(i, "AN").Value Next i, rng End Sub
Sub clr() Dim lr&, i&, rng As Range lr = Cells(Rows.Count, "AN").End(xlUp).Row For Each rng In Range("A1").CurrentRegion For i = 2 To lr If rng.Interior.Color = Cells(i, "AN").Interior.Color Then rng.Value = Cells(i, "AN").Value Next i, rng End Sub