关于自定义函数的使用理解及函数集锦

opiona

1. Sub test()
   
2.     ARX = Split("A1,B2:C3,D5:H8", ",") '//设置区域，可多个
   
3.     For Each SH In Worksheets
   
4.         If SH.Name <> "首页" Then  '//排除那些表格
   
5.             For I = 0 To UBound(ARX)
   
6.                 Set Rng = SH.Range(ARX(I))
   
7.                 Rng.Interior.Color = 65535  '//加粗，边框等代码自己加上吧
   
8.             Next
   
9.         End If
   
10.     Next
    
11. End Sub

复制代码

1681008

谢谢分享！

WYS67

opiona 发表于 2019-5-28 10:34

谢谢老师的无私分享！

lovemh1987

麻烦 老师，FILTER 函数能封装个吗？ 我的office365  没有这个函数。但是这个函数很强大，想试试。

opiona

1. 
   
2. 
   
3. Sub TEST()
   
4.     Dim ARX, BRX
   
5.     ARX = Split("AA,AB,AA,AC,AA,AD", ",")
   
6.     BRX = DiyFilter(ARX, "A", True, 0)
   
7.     BRX = DiyFilter(ARX, "A", True, 1)
   
8.     CRX = DiyFilter(ARX, "AA", True)
   
9.     MsgBox 1
   
10. End Sub
    
11. Function DiyFilter(SourceArray, Match, Optional ByVal Include As Boolean = True, Optional ByVal Compare As Integer = 0) As Variant()
    
12.     Rem  SourceArray 必需的?要执行搜索的一维字符串数组?
    
13.     Rem  Match       必需的?要搜索的字符串?
    
14.     Rem  Include     可选的。Boolean值，表示返回子串包含还是不包含match字符串。
    
15.     Rem                      Include=True  Filter返回的是包含Match子字符串的数组子集
    
16.     Rem                      Include=False Filter返回的不包含Match子字符串的数组子集。
    
17.     Rem  Compare     可选的。数字值，表示所使用的字符串比较类型。相同=0，包含=1
    
18. 
    
19.     Dim LB, I, X As Long
    
20.     LB = LBound(SourceArray)
    
21.     ReDim ARX(LB To LB)
    
22.     X = LB
    
23.     For I = LB To UBound(SourceArray)
    
24.         If Compare = 0 Then
    
25.             If ("" & SourceArray(I) = Match) = Include Then
    
26.                 ReDim Preserve ARX(LB To X)
    
27.                 ARX(X) = SourceArray(I)
    
28.                 X = X + 1
    
29.             End If
    
30.         Else
    
31.             If (InStr("" & SourceArray(I), Match) > 0) = Include Then
    
32.                 ReDim Preserve ARX(LB To X)
    
33.                 ARX(X) = SourceArray(I)
    
34.                 X = X + 1
    
35.             End If
    
36.         End If
    
37.     Next
    
38.     DiyFilter = ARX
    
39. End Function
    

复制代码

WYS67

opiona 发表于 2016-5-24 12:56
'为了使自定义函数用起来更像自带公式，要登记函数，就是运行下面的过程：RegUDF
'就可在工作表公式--选择 ...

向opiona老师致敬！祝老师国庆节快乐！

zhougencai

感谢大侠分享！！！好文章，学习了。

pu1980

学习中,还是感觉比较难
谢谢了!

opiona

jok22 发表于 2018-7-22 16:44
楼主你好，需要帮助，就是把VBA生成二维码做成自定义函数，从本论坛中找到了生成二维码的源代码，但自己水 ...

生成二维码: https://club.excelhome.net/thread-1535960-1-1.html
可使用插件, 也可以看看21楼的纯VBA实现的函数