VBA常用代码总结

目录

一，字符串操作.... 2

二，转换函数.... 2

三，时间函数.... 3

四，Excel vba语句... 4

.1.启用禁用事件.... 4

2. 启用禁用警告.... 4

3.取消复制选区.... 5

4.自动计算，禁用刷新.... 5

5. 状态栏进度.... 5

五，Excel单元格... 6

1.最后一行/列.... 6

2.单元格复制粘贴.... 6

3.设置单元格格式.... 6

六，Excel工作表... 7

1.判断工作表是否存在.... 7

2.插入工作表.... 8

3.隐藏工作表.... 8

4.移动工作表.... 8

5.检查工作表是否被保护.... 9

七，集合和数组.... 9

1.重新定义数组.... 9

2.一维数组遍历.... 9

3.二维数组遍历.... 9

4.数组维度.... 9

八，文件操作.... 10

1.创建文件夹.... 10

2.遍历当前文件夹文件.... 11

一，字符串操作

Trim(String) '去掉string左右两端空白

LTrim(String) '去掉string左端空白

RTrim(String) '去掉string右端空白

Len(String) '计算string长度

Left(String, x) '取string左段x个字符组成的字符串

Right(String, x) '取string右段x个字符组成的字符串

Mid(String, start, x) '取string从start位开始的x个字符组成的字符串

UCase(String) '转换为大写

LCase(String) '转换为小写

Space(x) '返回x个空白的字符串

Asc(String) '返回一个 integer，代表字符串中首字母的字符代码

二，转换函数

CBool(expression) '转换为Boolean型

CByte(expression) '转换为Byte型

CCur(expression) '转换为Currency型

CDate(expression) '转换为Date型

CDbl(expression) '转换为Double型

CDec(expression) '转换为Decemal型

CInt(expression) '转换为Integer型

CLng(expression) '转换为Long型

CSng(expression) '转换为Single型

CStr(expression) '转换为String型

CVar(expression) '转换为Variant型

Val(String) '转换为数据型

Str(number) '转换为String

三，时间函数

Now '返回一个 Variant (Date)，根据计算机系统设置的日期和时间来指定日期和时间。

Date '返回包含系统日期的 Variant (Date)。

Time '返回一个指明当前系统时间的 Variant (Date)。

Timer '返回一个 Single，代表从午夜开始到现在经过的秒数。

Second(Time) '返回一个 Variant (Integer)，其值为 0 到 59 之间的整数，表示一分钟之中的某个秒

Minute(Time) '返回一个 Variant (Integer)，其值为 0 到 59 之间的整数，表示一小时中的某分钟

Hour(Time) '返回一个 Variant (Integer)，其值为 0 到 23 之间的整数，表示一天之中的某一钟点

Day(Date) '返回一个 Variant (Integer)，其值为 1 到 31 之间的整数，表示一个月中的某一日

Month(Date) '返回一个 Variant (Integer)，其值为 1 到 12 之间的整数，表示一年中的某月

Year(Date) '返回 Variant (Integer)，包含表示年份的整数。

Weekday(Date, [firstdayofweek]) '返回一个 Variant (Integer)，包含一个整数，代表某个日期是星期几

TimeSerial(Hour, Minute, Second) '返回一个 Variant (Date)，包含具有具体时、分、秒的时间。

DateDiff(interval, date1, date2[, firstdayofweek[, firstweekofyear]]) '返回 Variant (Long) 的值，表示两个指定日期间的时间间隔数目

四，Excel vba语句

.1.启用禁用事件

Application.EnableEvents = False

Application.EnableEvents = True

2. 启用禁用警告

Application.DisplayAlerts = False

Application.DisplayAlerts = True

3.取消复制选区

Application.CutCopyMode = False '

4.自动计算，禁用刷新

VBA通常在程序开始加两句：

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

在结尾处再恢复：

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

5. 状态栏进度

Sub Main()

    Dim oldStatusBar

    oldStatusBar = Application.DisplayStatusBar

    Application.DisplayStatusBar = True

    Application.StatusBar = "正在刷新..."

    Application.StatusBar = "刷新完成!"

    delay 2

    Application.StatusBar = False

    Application.DisplayStatusBar = oldStatusBar

End Sub

五，Excel单元格

1.最后一行/列

ActiveSheet.Range("A:A").Find(What: = "*", LookIn: = xlFormulas, SearchOrder: = xlByRows, SearchDirection: = xlPrevious).Row

ActiveSheet.Range("1:1").Find(What: = "*", LookIn: = xlFormulas, SearchOrder: = xlByRows, SearchDirection: = xlPrevious).Column

2.单元格复制粘贴

Sub RangeCopy()

    Application.DisplayAlerts = False

    Sheet1.Range("A1").CurrentRegion.Copy Sheet2.Range("A1")

    Application.DisplayAlerts = True

End Sub

3.设置单元格格式

Public Sub RngFont()

    With Range("A1").Font '对A1单元格进行字体设置

        .Name = "华文彩云" 'Name属性返回或设置对象的名称

        .FontStyle = "Bold"设置为”Italic”倾斜字体

        .Size = 18 'Size属性返回或设置字体大小

        .ColorIndex = 3 '该颜色可指定为当前调色板中颜色的编号

        .Underline = 2 'Underline属性返回或设置应用于字体的下划线

    End With

End Sub

六，Excel工作表

1.判断工作表是否存在

Sub CheckSheetExist()

    Dim X As Integer

    For X = 1 To Sheets.Count

        If Sheets(X).Name = "A" Then

            MsgBox "A工作表存在"

            Exit Sub

        End If

    Next

    MsgBox "A工作表不存在"

End Sub

2.插入工作表

Sub s2()

    Dim sh As Worksheet

    Set sh = Sheets.Add

    sh.Name = "模板"

    sh.Range("a1") = 100

End Sub

3.隐藏工作表

Sub s3()

    Sheets(2).Visible = True

End Sub

4.移动工作表

Sub s4()

    Sheets("Sheet2").Move before: = Sheets("sheet1") 'sheet2移动到sheet1前面

    Sheets("Sheet1").Move after: = Sheets(Sheets.Count) 'sheet1移动到所有工作表的最后面

End Sub

5.检查工作表是否被保护

If ActiveSheet.ProtectContents Or ActiveSheet.ProtectDrawingObjects Then MsgBox "工作表已保护,本程序拒绝执行！", 64, "友情提示": Exit Sub

七，集合和数组

1.重新定义数组

ReDim Preserve

2.一维数组遍历

For i = LBound(aryData) To UBound(aryData)

    aryData(i) = 1

Next

3.二维数组遍历

For i = LBound(aryData) To UBound(aryData)

    For j = LBound(aryData, 2) To UBound(aryData, 2)

        aryData(i, j) = 1

    Next

Next

4.数组维度

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

八，文件操作

1.创建文件夹

Function MkDir2(path)

    If Dir(path, vbDirectory) = "" Then

        MkDir path '建立文件夹

    End If

End Function

2.遍历当前文件夹文件

Function DirFiles(ByVal mypath, Optional ByVal fileStr = "*.*")

    '返回一个数组2列 '1 列 -纯文件名+后缀 '2 列 -完整路径

    '3 列  纯文件名 '4列  纯后缀 '本函数默认不搜索 隐藏文件

    If mypath Like "*\" Then '总是把传进来的路径处理成不带斜杠的数据

        mypath = Left(mypath, Len(mypath) - 1) '去掉最后的分隔符

    End If

    Dim dic

    Set dic = CreateObject("scripting.dictionary")

    Dim fname, k

    fname = Dir(mypath & "\" & fileStr)

    k = 0

    Do While fname <> "" '不为空的时候 往下循环

        k = k + 1

        If fname Like fileStr Then '实现模糊搜索文件

            dic(k) = fname '写入第一个文件

        End If

        fname = Dir

    Loop

    Dim brr

    If dic.Count = 0 Then

        ReDim brr(0, 0)

    Else

        ReDim brr(1 To dic.Count, 1 To 4) '1列纯文件名 2列完整文件名

        For i = 1 To dic.Count

            brr(i, 1) = dic(i) '纯文件名

            brr(i, 2) = mypath & "\" & brr(i, 1) '完整路径+文件名

            brr(i, 3) = Left(brr(i, 1), InStrRev(brr(i, 1), ".") - 1) '纯文件名

            brr(i, 4) = Mid(brr(i, 1), InStrRev(brr(i, 1), ".") + 1) '路径

        Next

    End If

    DirFiles = brr

    '返回结果字典

End Function