Sub asd() Const dRh# = 15.75 Dim rRow As Range, r As Range, r1 As Range
With ActiveSheet.UsedRange .Interior.Color = xlNone For Each rRow In .Rows Select Case True Case rRow.RowHeight >= dRh If r Is Nothing Then Set r = rRow Else Set r = Union(r, rRow) End If Case rRow.RowHeight < dRh If r1 Is Nothing Then Set r1 = rRow Else Set r1 = Union(r1, rRow) End If End Select Next End With r.Rows.Interior.Color = vbRed r1.Rows.Interior.Color = vbGreen
End Sub
[/vba]
Здрвствуйте[vba]
Код
Sub asd() Const dRh# = 15.75 Dim rRow As Range, r As Range, r1 As Range
With ActiveSheet.UsedRange .Interior.Color = xlNone For Each rRow In .Rows Select Case True Case rRow.RowHeight >= dRh If r Is Nothing Then Set r = rRow Else Set r = Union(r, rRow) End If Case rRow.RowHeight < dRh If r1 Is Nothing Then Set r1 = rRow Else Set r1 = Union(r1, rRow) End If End Select Next End With r.Rows.Interior.Color = vbRed r1.Rows.Interior.Color = vbGreen
Sub asd() Const dRh# = 15.75 Dim rRow As Range, r As Range, r1 As Range
With ActiveSheet.UsedRange .Interior.Color = xlNone
For Each rRow In .Rows Select Case rRow.RowHeight Case Is >= dRh: Call AddRange(r, rRow) Case Is < dRh:: Call AddRange(r1, rRow) End Select Next End With
If Not r Is Nothing Then r.Rows.Interior.Color = vbRed If Not r1 Is Nothing Then r1.Rows.Interior.Color = vbGreen
Set r = Nothing: Set r1 = Nothing End Sub
Sub AddRange(rRng As Range, rRow As Range) If rRng Is Nothing Then Set rRng = rRow Else Set rRng = Union(rRng, rRow) End If End Sub
[/vba]
Другое видение того же кода[vba]
Код
Sub asd() Const dRh# = 15.75 Dim rRow As Range, r As Range, r1 As Range
With ActiveSheet.UsedRange .Interior.Color = xlNone
For Each rRow In .Rows Select Case rRow.RowHeight Case Is >= dRh: Call AddRange(r, rRow) Case Is < dRh:: Call AddRange(r1, rRow) End Select Next End With
If Not r Is Nothing Then r.Rows.Interior.Color = vbRed If Not r1 Is Nothing Then r1.Rows.Interior.Color = vbGreen
Set r = Nothing: Set r1 = Nothing End Sub
Sub AddRange(rRng As Range, rRow As Range) If rRng Is Nothing Then Set rRng = rRow Else Set rRng = Union(rRng, rRow) End If End Sub
ub asd() Const dRh# = 15.75 Dim rRow As Range, r As Range, r1 As Range
With ActiveSheet.UsedRange .Interior.Color = xlNone For Each rRow In .Rows Select Case True Case rRow.RowHeight >= dRh If r Is Nothing Then Set r = rRow Else Set r = Union(r, rRow) End If Case rRow.RowHeight < dRh If r1 Is Nothing Then Set r1 = rRow Else Set r1 = Union(r1, rRow) End If End Select Next End With r.Rows.Interior.Color = vbRed r1.Rows.Interior.Color = vbGreen
ub asd() Const dRh# = 15.75 Dim rRow As Range, r As Range, r1 As Range
With ActiveSheet.UsedRange .Interior.Color = xlNone For Each rRow In .Rows Select Case True Case rRow.RowHeight >= dRh If r Is Nothing Then Set r = rRow Else Set r = Union(r, rRow) End If Case rRow.RowHeight < dRh If r1 Is Nothing Then Set r1 = rRow Else Set r1 = Union(r1, rRow) End If End Select Next End With r.Rows.Interior.Color = vbRed r1.Rows.Interior.Color = vbGreen