文章目录
需求1: 工作簿内各表单元格区域红色字体求和
普通写法:
Sub demo()
Dim i As Long, j As Long, s As Long
Dim r As Range, w As Worksheet, r1 As Range 's和, w 表格, r 单元格, r1 子单元格
For Each w In Worksheets
s = 0 '和
Set r = w.UsedRange
For Each r1 In r
If r1.Font.Color = vbRed Then
s = s + r1.Value
Next r1
w.Cells(1, 1) = s
Next w
End Sub
过程化写法: Range自定义函数
Sub demo()
Dim w As Worksheet 's和, w 表格, r 单元格, r1 子单元格
For Each w In Worksheets
w.Cells(1, 1) = redCount(w.UsedRange)
w.Cells(1, 1).Font.Color = vbBlue
Next w
End Sub
--------------------------------------------------------------------------------------------------'
' 本函数接收一个Range类型变量作为参数
' 然后扫描其中每一个单元格,将红色数字汇总返回>>>>>>>>>>>>>>可以当做自定义公式
Function redCount(r As Range)
Dim s As Long
Dim r1 As Range
'和
For Each r1 In r
If r1.Font.Color = vbRed Then
s = s + r1.Value
End If
Next r1
redCount = s
End Function
需求2: 按行求积再相加
Function mySumProduct(r As Range)
Dim i&, j&, k&, s&
s = 0 '求和
For i = 1 To r.Rows.Count
k = 1 '求积
For j = 1 To r.Columns.Count
k = k * Cells(i, j)
Next j
s = s + k
Next i
mySumProduct = s
End Function
Range.hasFormula属性
判断单元格是否是公式
当该Range为一个单元格时,若是公式返回True,否则返回False
Range.Formula属性
当该Range为一个单元格时,若是公式则返回公式文本,否则与Value属性一样,返回单元格内容
需求3: 公式转换为值
Sub replaceFormula()
Dim w As Worksheet
For Each w In Worksheets
w.UsedRange.Value = w.UsedRange.Value
Next w
End Sub