VBA用自定义函数 对多个区域计算含有公式的单元格个数

laoau138

VBA用自定义函数  对多个区域计算含有公式的单元格个数

一沫昔阳虹w

比较蛋疼，但是可以实现你的要求

1. Function FunCrank(ByVal rng1 As Range, Optional ByVal rng2 As Range, Optional ByVal rng3 As Range, _
   
2.         Optional ByVal rng4 As Range, Optional ByVal rng5 As Range, Optional ByVal rng6 As Range)
   
3.     '比较蛋疼，用参数数组好像不可以，没弄出来，区域不够自己再加吧
   
4.     Dim totalRange As Range, rng As Range
   
5.    
   
6.     Set totalRange = rng1
   
7.     Call UnionRange(totalRange, rng2)   '判断，合并区域
   
8.     Call UnionRange(totalRange, rng3)
   
9.     Call UnionRange(totalRange, rng4)
   
10.     Call UnionRange(totalRange, rng5)
    
11.     Call UnionRange(totalRange, rng6)
    
12.     '--------------------------------------------------------------
    
13.     For Each rng In totalRange
    
14.             If rng.HasFormula Then FunCrank = FunCrank + 1  '判断单元格是否含有公式
    
15.     Next
    
16. End Function
    
17. 
    
18. Sub UnionRange(ByRef MainRng As Range, ByVal rng As Range)  '自定义方法，主参数使用传地址，有条件合并区域
    
19.         If Not rng Is Nothing Then Set MainRng = Union(MainRng, rng)    '
    
20. End Sub
    

复制代码

laoau138

一沫昔阳虹w 发表于 2016-12-8 08:42
比较蛋疼，但是可以实现你的要求

书本上的方法         还能怎样优化

Function Functions(ParamArray rng() As Variant)  '声明函数名称，有多个可选参数，包括1到255个
  Dim cell, Fun_count As Long, i As Byte, celll As Range  '声明变量
  Application.Volatile  '声明为易失性函数
  If UBound(rng) = -1 Then Functions = 0: Exit Function  '如果无参数则结果为0
  For i = 0 To UBound(rng)   '遍历每个参数
  If Not IsMissing(rng(i)) Then  '如果有参数
    Set celll = Application.Intersect(rng(i), ActiveSheet.UsedRange)
    For Each cell In celll  '遍历区域中每个元素
    If cell.HasFormula Then Fun_tion = Fun_tion + 1  '如果有公式则累加变量
    Next cell
  End If
  Next i
  Functions = Fun_tion  '统计结果
End Function

laoau138

谁能写好更好的代码
Function Functions(ParamArray b())
Dim n As Long

For Each c In b
For Each rng In c
     If rng.HasFormula Then n = n + 1  '判断单元格是否含有公式
Next
Next
Functions = n
End Function

一沫昔阳虹w

laoau138 发表于 2016-12-8 18:00
谁能写好更好的代码
Function Functions(ParamArray b())
Dim n As Long

参数数组没怎么用过，硬是没弄出来，可以可以，学习了

laoau138

一沫昔阳虹w 发表于 2016-12-8 18:38
参数数组没怎么用过，硬是没弄出来，可以可以，学习了

高手这条怎样做


用VBA开发具有三个参数自定义函数

http://www.excelpx.com/thread-426106-1-1.html

laoau138

一沫昔阳虹w 发表于 2016-12-8 18:38
参数数组没怎么用过，硬是没弄出来，可以可以，学习了

VBA如何改写自宝义函数     有三个参数   第三个为可选参数

http://www.excelpx.com/thread-426296-1-1.html

一沫昔阳虹w

1. Function SumIFColor(条件区 As Range, 颜色单元格1 As Range, 颜色单元格2 As Range, Optional 统计区)
   
2.   Dim arr(), Item, i As Long    '声明变量
   
3.   If IsMissing(统计区) Then  '如果第三参数被忽略
   
4.     '则将“条件区”当作“统计区”,并将它赋值给数组变量arr(使用数组可对代码提速）
   
5.     arr = Intersect(条件区, 条件区.Parent.UsedRange).Value
   
6.   Else             '否则
   
7.     '将“统计区”参数重置为“条件区”的相同高度和宽度，然后赋值给数组变量arr
   
8.     arr = 统计区(1).Resize(条件区.Rows.Count, 条件区.Columns.Count).Value
   
9.   End If
   
10.   For Each Item In arr  '遍历数组arr
    
11.     i = i + 1     '累加计数器
    
12.     '如果条件区中某个单元格背景色与颜色单元格区域(参照区)颜色一致
    
13.     If 条件区.Cells(i).Interior.Color = 颜色单元格1(1).Interior.Color Or 颜色单元格2(1).Interior.Color Then
    
14.       SumIFColor = SumIFColor + Item '将数组中对应的数值累加到SumIFColor中
    
15.     End If
    
16.   Next
    
17. End Function

复制代码

laoau138

一沫昔阳虹w 发表于 2016-12-12 07:54

把答案发到这里才能采纳

http://www.excelpx.com/thread-426296-1-1.html