For i = 1 To 12 For j = 1 To 16 If Cells(i, j).Interior.ColorIndex = Cells(2, 2).Interior.ColorIndex Then Cells(i, j).ClearContents If Cells(i, j).Interior.ColorIndex = Cells(1, 2).Interior.ColorIndex And _ Cells(i + 1, j).Interior.ColorIndex = Cells(2, 2).Interior.ColorIndex Then Cells(i, j).ClearContents Next j Next i End Sub
[/vba]
и я свой ... ))
[vba]
Код
Public Sub MyClean()
For i = 1 To 12 For j = 1 To 16 If Cells(i, j).Interior.ColorIndex = Cells(2, 2).Interior.ColorIndex Then Cells(i, j).ClearContents If Cells(i, j).Interior.ColorIndex = Cells(1, 2).Interior.ColorIndex And _ Cells(i + 1, j).Interior.ColorIndex = Cells(2, 2).Interior.ColorIndex Then Cells(i, j).ClearContents Next j Next i End Sub
Option Explicit Public Sub test() Dim rng1 As Range Dim rngCell Dim colorCell(1 To 2) As Long Const orange As Byte = 1 Const grey As Byte = 2
Set rng1 = Worksheets(1).UsedRange colorCell(grey) = Range("E1").Interior.Color colorCell(orange) = Range("E8").Interior.Color
For Each rngCell In rng1 If (rngCell.Interior.Color = colorCell(orange)) Or _ ((rngCell.Interior.Color = colorCell(grey)) And (rngCell.Offset(1, 0).Interior.Color = colorCell(orange))) Then rngCell.ClearContents End If
Next End Sub
[/vba]
ещё вариант [vba]
Код
Option Explicit Public Sub test() Dim rng1 As Range Dim rngCell Dim colorCell(1 To 2) As Long Const orange As Byte = 1 Const grey As Byte = 2
Set rng1 = Worksheets(1).UsedRange colorCell(grey) = Range("E1").Interior.Color colorCell(orange) = Range("E8").Interior.Color
For Each rngCell In rng1 If (rngCell.Interior.Color = colorCell(orange)) Or _ ((rngCell.Interior.Color = colorCell(grey)) And (rngCell.Offset(1, 0).Interior.Color = colorCell(orange))) Then rngCell.ClearContents End If
спасибо,я разобрался как работает ваш макрос.А можно ли просто задать условие по цвету,а не указывать конкретные координаты оранжевого и серого?просто в разных файлах на этих местах может быть другой цвет ячейки.
спасибо,я разобрался как работает ваш макрос.А можно ли просто задать условие по цвету,а не указывать конкретные координаты оранжевого и серого?просто в разных файлах на этих местах может быть другой цвет ячейки.lamak58
For i = 1 To UsedRange.Rows.Count For j = 1 To UsedRange.Columns.Count If Cells(i, j).Interior.ColorIndex = 45 Then Cells(i, j).ClearContents If Cells(i, j).Interior.ColorIndex = 15 And _ Cells(i + 1, j).Interior.ColorIndex = 45 Then Cells(i, j).ClearContents Next j Next i End Sub
[/vba]
[vba]
Код
Public Sub MyClean()
For i = 1 To UsedRange.Rows.Count For j = 1 To UsedRange.Columns.Count If Cells(i, j).Interior.ColorIndex = 45 Then Cells(i, j).ClearContents If Cells(i, j).Interior.ColorIndex = 15 And _ Cells(i + 1, j).Interior.ColorIndex = 45 Then Cells(i, j).ClearContents Next j Next i End Sub
For i = 1 To ActiveSheet.UsedRange.Rows.Count For j = 1 To ActiveSheet.UsedRange.Columns.Count If Cells(i, j).Interior.ColorIndex = 45 Then Cells(i, j).ClearContents If Cells(i, j).Interior.ColorIndex = 15 And _ Cells(i + 1, j).Interior.ColorIndex = 45 Then Cells(i, j).ClearContents Next j Next i End Sub
[/vba]
[vba]
Код
Public Sub MyClean()
For i = 1 To ActiveSheet.UsedRange.Rows.Count For j = 1 To ActiveSheet.UsedRange.Columns.Count If Cells(i, j).Interior.ColorIndex = 45 Then Cells(i, j).ClearContents If Cells(i, j).Interior.ColorIndex = 15 And _ Cells(i + 1, j).Interior.ColorIndex = 45 Then Cells(i, j).ClearContents Next j Next i End Sub
.А можно ли просто задать условие по цвету,а не указывать конкретные координаты
можно и константой [vba]
Код
Option Explicit Public Sub test() Dim rng1 As Range Dim rngCell Dim colorCell(1 To 2) As Long Const orange As Byte = 1 Const grey As Byte = 2
Set rng1 = Worksheets(1).UsedRange colorCell(grey) = 12632256 colorCell(orange) = 42495
For Each rngCell In rng1 If (rngCell.Interior.Color = colorCell(orange)) Or ((rngCell.Interior.Color = colorCell(grey)) And (rngCell.Offset(1, 0).Interior.Color = colorCell(orange))) Then rngCell.ClearContents End If
.А можно ли просто задать условие по цвету,а не указывать конкретные координаты
можно и константой [vba]
Код
Option Explicit Public Sub test() Dim rng1 As Range Dim rngCell Dim colorCell(1 To 2) As Long Const orange As Byte = 1 Const grey As Byte = 2
Set rng1 = Worksheets(1).UsedRange colorCell(grey) = 12632256 colorCell(orange) = 42495
For Each rngCell In rng1 If (rngCell.Interior.Color = colorCell(orange)) Or ((rngCell.Interior.Color = colorCell(grey)) And (rngCell.Offset(1, 0).Interior.Color = colorCell(orange))) Then rngCell.ClearContents End If