VBA提高篇_16 传递Range提升自定义函数,巧用属分辨公式型内容

需求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