标题: Traffic lighting of numeric variables by SAS or VBA [打印本页] 作者: shiyiming 时间: 2012-5-26 06:31 标题: Traffic lighting of numeric variables by SAS or VBA From Dapangmao's blog on sas-analysis
“Traffic lighting” applies distinctive colors to any numeric variables to indicate the ranges, which is particularly important for Excel reporting. In SAS, it can be easily realized by a user defined format. For example, if I want to add yellow color attribute to all numeric variables, which are great than 60, I can create a color format and cast it toward the target Excel file created by ODS destination.
<pre style="background-color: #ebebeb; border: 1px dashed rgb(153, 153, 153); color: #000001; font-size: 14px; line-height: 14px; overflow: auto; padding: 5px; width: 100%;"><code>
data class;
set sashelp.class;
run;
* Create a user defined format
proc format;
value range
60 - high = 'yellow'
other = 'white';
run;
* Apply the color format for all numeric variables
ods html file = "c:\tmp\label_excel.xls" style = minimal;
proc print data = class nobs;
var _character_ ;
var _numeric_ / style = [background = range.];
run;
ods html close;
</code></pre>
Similarly, a VBA subroutine can do the global search based on the specified ranges with a looping structure around the numeric variables. The looking of the resulting Excel files by either SAS or VBA are essentially identical.
<pre style="background-color: #ebebeb; border: 1px dashed rgb(153, 153, 153); color: #000001; font-size: 14px; line-height: 14px; overflow: auto; padding: 5px; width: 100%;"><code>
Sub global_label()
Dim Cell As Object
Dim myCell As Range
Dim myRange As Range
' Specify selection ranges
If TypeName(Selection) <> "Range" Then Exit Sub
If Selection.CountLarge = 1 Then
Set myRange = ActiveSheet.UsedRange
Else
Set myRange = Application.Intersect(Selection, ActiveSheet.UsedRange)
End If
' Only search numeric cells
On Error Resume Next
Set myRange = myRange.SpecialCells(xlConstants, xlNumbers)
If myRange Is Nothing Then Exit Sub
On Error GoTo 0
' Aggregate cells
For Each Cell In myRange
If Cell.Value > 60 Then
If myCell Is Nothing Then
Set myCell = Cell
Else
Set myCell = Application.Union(myCell, Cell)
End If
End If
Next Cell
' Label qualified cells
If myCell Is Nothing Then
MsgBox "No matching cell is found"
Else
myCell.Select
With Selection.Interior
.Pattern = xlSolid
.Color = 65535
End With
End If
End Sub
</code></pre><div class="blogger-post-footer"><img width='1' height='1' src='https://blogger.googleusercontent.com/tracker/3256159328630041416-4936187068146697788?l=www.sasanalysis.com' alt='' /></div><img src="http://feeds.feedburner.com/~r/SasAnalysis/~4/FPYYhuSYybQ" height="1" width="1"/>