日常记录一般EXCEL进行比较时,根据差异进行单元格颜色标
'进行数据比较分析
'nRow:开始行数
'nClm:比较数列
'nMonth:循环月份YTD
Sub Analysis_WS_by_Color(ByVal Sht$, ByVal iRow, ByVal nClm, ByVal nMonth)
Dim iMaxRow, iMaxClm
Dim m, n
Dim baseVal As Double
Dim targetVal As Double
Dim diff As Double
Dim ColorRange
With Sheets(Sht)
iMaxRow = .Cells(65536, 1).End(xlUp).Row
iMaxClm = 2 + nMonth
For m = iRow To iMaxRow
baseVal = .Cells(m, nClm) '比较基数
For n = 3 To iMaxClm
targetVal = Round(.Cells(m, n), 0) '目标数
If targetVal = 0 Then diff = 0 Else diff = Round(targetVal - baseVal, 0)
ColorRange = Round(Abs(targetVal / baseVal - 1), 2)
If ColorRange > 1 Then ColorRange = 1
'处理单元格颜色
Select Case diff
Case Is > 0
.Cells(m, n).Interior.ColorIndex = 6 'Yellow
.Cells(m, n).Interior.TintAndShade = 1 - ColorRange
Case Is = 0
.Cells(m, n).Interior.ColorIndex = 0
Case Is < 0
.Cells(m, n).Interior.ColorIndex = 14 'Green
.Cells(m, n).Interior.TintAndShade = 1 - ColorRange
End Select
Next n
Next m
End With
End Sub
效果如下: