【源码分享】VBA中一些常用的自定义函数
VBA说
共 3843字,需浏览 8分钟
· 2021-01-16
▎写在前面
都说写VBA像累积木,除了核心部分的循环逻辑思路,其余都是再堆砌代码。这篇文章就罗列一下我在写VBA程序中,常用的一些自定义函数。
•列标相互转换
很多时候得到的列标是数字列标,需要把它转成英文列标的形式,比如下面的语句中col变量就是数字。
col = Cells(1, Columns.Count).End(xlToLeft).Column
但是如果我们需要这个数字所对应的英文列标,这个时候就需要下面的自定义函数进行便捷转化。
自定义函数代码:
'列数转字母
Function CNtoW(ByVal num As Long) As String
CNtoW = Replace(Cells(1, num).Address(False, False), "1", "")
End Function
'字母转列数
Function CWtoN(ByVal AB As String) As Long
CWtoN = Range("a1:" & AB & "1").Cells.Count
End Function
代码使用实例:
Sub test()
col = Cells(1, Columns.Count).End(xlToLeft).Column
Range("a1:" & CNtoW(col) & 1).Select
End Sub
•判断文件夹是否存在
往往存储运行结果需要建文件夹的时候,需要首先判断下文件夹是否存在,如果不判断直接新建,程序会报错。
自定义函数代码:
Public Function FileFolderExists(ByVal strFullPath As String) As Boolean
If Not Dir(strFullPath, vbDirectory) = vbNullString Then
FileFolderExists = True
Else
FileFolderExists = False
End If
End Function
如果不使用自定义函数,FSO的方式自带判断文件夹是否存在的方法
Sub 新建文件夹()
PathG = "D:\folder1"
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(PathG) = True Then
'//删除文件夹
MkDir PathG '//创建文件夹
Else
MkDir PathG '//创建文件夹
End If
End Sub
•判断文件是否存在
方法一:Dir函数法
Function IsFileExists(ByVal strFileName As String) As Boolean
If Dir(strFileName) <> Empty Then
IsFileExists = True
Else
IsFileExists = False
End If
End Function
Sub Run()
If IsFileExists("D:\vba\abc.txt") = True Then
' 文件存在时的处理
MsgBox "文件存在!"
Else
' 文件不存在时的处理
MsgBox "文件不存在!"
End If
End Sub
方法二:FSO对象方法
Function IsFileExists(ByVal strFileName As String) As Boolean
Dim objFileSystem As Object
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
If objFileSystem.fileExists(strFileName) = True Then
IsFileExists = True
Else
IsFileExists = False
End If
End Function
Sub Run()
If IsFileExists("D:\vba\abc.txt") = True Then
' 文件存在时的处理
MsgBox "文件存在!"
Else
' 文件不存在时的处理
MsgBox "文件不存在!"
End If
End Sub
•判断WorkSheet是否存在
新建WorkSheet的时候,如果已经存在相同名字的WorkSheet,程序就会报错,一般先判断下某个WorkSheet是否存在,不存在的时候才进行新建操作。
Sub 新建sheet()
If SheetExists("表一") = False Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "表一"
End If
End Sub
Function SheetExists(sname) As Boolean
Dim x As Object
On Error Resume Next
Set x = ActiveWorkbook.Sheets(sname)
If Err = 0 Then SheetExists = True _
Else SheetExists = False
End Function
•对数组进行转置
通常数组转置都是借助工作表函数transpose,但是他的限制太多。
1.数量不能超过65536
2.数组中元素的长度不能超过255
所以,如果元素过多,就是用自定义数组转置函数来解决。
Function Transpose2(arr As Variant)
'转置核心代码
Dim brr(), i, j, n
n = NumberOfArrayDimensions(arr)
If n = 1 Then
ReDim brr(LBound(arr) To UBound(arr), 1 To 1)
For i = LBound(arr) To UBound(arr)
brr(i, 1) = arr(i)
Next
Else
ReDim brr(LBound(arr, 2) To UBound(arr, 2), LBound(arr) To UBound(arr))
For i = LBound(arr) To UBound(arr)
For j = LBound(arr, 2) To UBound(arr, 2)
brr(j, i) = arr(i, j)
Next
Next
End If
Transpose2 = brr
End Function
Public Function NumberOfArrayDimensions(arr As Variant) As Integer
Dim Ndx As Integer
Dim Res As Integer
On Error Resume Next
Do
Ndx = Ndx + 1
Res = UBound(arr, Ndx)
Loop Until Err.Number <> 0
NumberOfArrayDimensions = Ndx - 1
End Function
•判断本机是否联网
Private Declare Function InternetGetConnectedState Lib "wininet.dll" _
(ByRef dwFlags As Long, ByVal dwReserved As Long) As Long
Sub 运用VBA判断计算机是否连网()
If InternetGetConnectedState(0&, 0&) Then
MsgBox "已连网"
Else
MsgBox "未连网"
End If
End Sub
【建议收藏】VBA说历史文章汇总 速码工具箱2.0发布,更强大的功能等你来体验! VBA会被Python代替吗? 代码存储美化工具测评-【VBE2019】 Excel和Word数据交互读取(生成合同)
评论
金融研究 | 使用Python测量关键审计事项的「信息含量」
Tips: 公众号推送后内容只能更改一次,且只能改20字符。如果内容出问题,或者想更新内容, 只能重复推送。为了更好的阅读体验,建议阅读本文博客版, 链接地址https://textdata.cn/blog/2023-01-13-information-content-of-critical-aud
大邓和他的Python
0
我看阿里的年终奖总算发了!
到4月底了,这两天看朋友圈,发现阿里的年终奖终于发了,问了问老同学,也从网上检索了不少信息,基本搞清楚了阿里今年的年终奖情况。近来来阿里一些集团对绩效等级做了较大的调整,以前的旧绩效系统中,绩效分为3.25、3.5、3.75、4和5五个等级,其中4和5是较高绩效等级,较少见。而且之前3.5绩效内部划
公子龙
0
金融研究(更新) | 使用Python构建关键审计事项的「信息含量」
Tips: 公众号推送后内容只能更改一次,且只能改20字符。如果内容出问题,或者想更新内容, 只能重复推送。为了更好的阅读体验,建议阅读本文博客版, 链接地址https://textdata.cn/blog/2023-01-13-information-content-of-critical-aud
大邓和他的Python
0
盘点Lombok的几个骚操作,你绝对没用过!
👉 欢迎加入小哈的星球 ,你将获得: 专属的项目实战 / Java 学习路线 / 一对一提问 / 学习打卡 / 赠书福利全栈前后端分离博客项目 2.0 版本完结啦, 演示链接:http://116.62.199.48/ ,新项目正在酝酿中
小哈学Java
0
堪称最优秀的Docker可视化管理工具——Portainer你真的会用吗?
来源:blog.csdn.net/shark_chili3007/article/details/123366179👉 欢迎加入小哈的星球 ,你将获得: 专属的项目实战 / Java 学习路线 / 一对一提问 / 学习打卡 / 赠书福利全栈前后端分离博客项目
小哈学Java
0
Apache Paimon毕业,湖仓架构的未来发展趋势!
北京时间 2024 年 4 月 16日,开源软件基金会 Apache Software Foundation(以下简称 ASF)正式宣布 Apache Paimon 毕业成为 Apache 顶级项目(TLP, Top Level Project)。经过社区的共同努力和持续创新,Apache Paim
程序源代码
0
JS的这些新特性,你都用过么?
大厂技术 高级前端 Node进阶点击上方 程序员成长指北,关注公众号回复1,加入高级Node交流群作为一门不断演进的语言,JavaScript每年都会引入新特性。这些特性的加入,能够帮助我们编写更加简洁、高效、易于维护的代码。然而,并非所有新特性
程序员成长指北
1
【深度学习】人人都能看懂的LSTM
熟悉深度学习的朋友知道,LSTM是一种RNN模型,可以方便地处理时间序列数据,在NLP等领域有广泛应用。在看了台大李宏毅教授的深度学习视频后,特别是介绍的第一部分RNN以及LSTM,整个人醍醐灌顶。本文就是对视频的记录加上了一些个人的思考。0. 从RNN说起循环神经网络(Recurrent Neur
机器学习初学者
0