VB 使用总结

VB参考
官方文档

1. 调用方法

function 参数1,参数2.....

2. 清除

Worksheets("Sheet1").Range("a2:I1000000").SpecialCells(2).ClearContents '清除单元格内容不清除公式
Worksheets("Sheet1").Range("a2:I1000000").Clear'全部清除
Worksheets("Sheet1").Range("a2:I1000000").Delete'删除内容

3. 读取数据库表数据到excel表中

Dim rs As New ADODB.Recordset '设置一个Recordset对象, 该对象用作指定的查询表的数据源
Dim cn As New ADODB.Connection '定义连接
Dim strCn, strSQL As String '定义连接和sql执行变量
strCn = "Provider=sqloledb;Server=127.0.0.1;Database=TestDB;Uid=sa;Pwd=123456;"'数据库连接字符串
cn.Open strCn'打开数据库连接
strSQL = "SELECT * FROM [TestDB].[dbo].[TEST]" 'sql查询语句
rs.Open strSQL, cn'执行sql语句
'方法一 缺点：当有大量数据时读取速度很慢
sg_i=1'行号
Do While Not rs.EOF '循环得到数据，并填充到表格中
        Worksheets(t).Cells(sg_i, 1) = rs("列名1")
        Worksheets(t).Cells(sg_i, 2) = rs("列名2")
        Worksheets(t).Cells(sg_i, 3) = rs("列名3")
        Worksheets(t).Cells(sg_i, 4) = rs("列名4")
        Worksheets(t).Cells(sg_i, 5) = rs("列名5")
    rs.MoveNext
    sg_i = sg_i + 1
Loop
'方法二 快速读取并填充
irows = rs.RecordCount + 1
icolumns = rs.Fields.Count
'列名
For i = 0 To icolumns - 1
    Worksheets(t).Cells(1, i + 1) = rs.Fields(i).Name
Next
'数据
Worksheets(t).Range("a2").CopyFromRecordset rs
'方法三  不用单独查询标题，查询速度与填充速度很快
    Set qt = Worksheets(t).QueryTables.Add(rs, Worksheets(t).Range("a1"))
    
    With qt
        .FieldNames = True '数据源的字段名称作为返回数据的列标题显示
        .RowNumbers = False '行号作为第一列添加到指定查询表
        .FillAdjacentFormulas = False '每当查询表刷新时，指定查询表右侧的公式就自动更新
        .PreserveFormatting = False '将数据前五行的任何常用格式设置应用到查询表的新数据行
        .RefreshOnFileOpen = False '每次打开工作簿时，数据透视表高速缓存或查询表自动更新,False为不自动更新
        .BackgroundQuery = True '查询表的查询是异步执行（在后台执行）的
        .RefreshStyle = xlInsertDeleteCells '返回或设置指定工作表中的行的添加或删除方式, 以适应查询返回的 recordset 中的行数
        .SavePassword = True '将 ODBC 连接字符串中的密码信息与指定查询一起保存
        .SaveData = True '将数据透视表的数据随工作簿一起保存
        .AdjustColumnWidth = False '每次刷新指定的查询表时列宽都会自动调整为最适合的宽度
        .RefreshPeriod = 0 '设置两次刷新之间的时间间隔
        .PreserveColumnInfo = False '每次刷新查询表时，列排序、筛选和布局信息都会保留，则该值为 True。 默认值为 True 。False用于与早期版本兼容
        .EnableRefresh = False
    End With
    qt.FieldNames = True '显示标题
    qt.Refresh
If rs.State = 1 Then rs.Close '如果rs结束了操作就关闭

4. Protection 对象 (Excel)
   官方解释文档
   应用，保护表Sheet1，密码是123456，允许自动筛选，删除行

Worksheets("Sheet1").Protect Password:="123456", AllowFiltering:=True, AllowDeletingRows:=True

5. VB/VBA如何计算出数组的元素个数（长度）
   数组下限：LBOUND(数组） 结果：一般为0
   数组上限：UBOUND(数组）
   数组长度： UBOUND(数组）-LBOUND(数组）+1
6. 设置单元格样式

'==================================================================
'f_color: 字体颜色 例如，1,2,3
'b_color: 背景颜色 例如，RGB(0,255,255)
'border_color: 边框颜色 例如，RGB(0,255,255)
'rang_set: 单元格或者单元格区域
'==================================================================
Public Sub SetCellsStyle(f_color, b_color, border_color, range_set As Range)
    range_set.Interior.Color = b_color
    range_set.Font.ColorIndex = f_color
    range_set.Borders().Color = border_color
End Sub

7. 报错
   
   第一个类型 : 传递参数未定义类型,假如参数在调用前未定义类型,系统自动将他定义为variant类型,由于和过程或函数中的对就参数类型不相同,所以提示”byref参数类型不符”
   第二个类型 : 传递参数类型已定义,但由于定义方法不对,所以提示”byref参数类型不符” 2、出错原因 在上机的时候出错原因是因为第二个类型:传递参数类型已定义,但由于定义方法不对。
   解决方案：
   检查传入参数与方法的设置参数数据类型是否一致
8. 行数，列数

 irows = Worksheets(s_t).Range("a1").CurrentRegion.Rows.Count '当前行数
 iRows=Worksheets("Sheet1").UsedRange.Rows.Count
 icolumns = Worksheets(s_t).Range("a1").CurrentRegion.Columns.Count '当前列数
 iColumns=Worksheets("Sheet1").UsedRange.Columns.Count

9. borders Linestyle 设置边框样式
   xlTransparent 0 透明
   xlSolid 1 （缺省值）实线。边框处于形状边缘的中心。
   xlDash 2 虚线
   xlDot 3 点线
   xlDashDot 4 点划线
   xlDashDotDot 5 双点划线
   xlInsideSolid 6 内收实线。边框的外边界就是形状的外边缘。
   使用方法：

With Worksheets("Sheet1").UsedRange.Borders
    .LineStyle = xlSolid
End With

With Worksheets("Sheet1")
    .Range(.Cells(1, 1), .Cells(1, icolumns)).Interior.Color = RGB(0, 191, 255) '设标题背景为蓝色
    .Range(.Cells(1, 1), .Cells(irows, icolumns)).Borders.LineStyle = xlSolid '给数据加边框
End With

10. 设置单元格数据格式

    [a1].NumberFormatLocal = "@" '设置A1单元格为文本格式

    [b1].NumberFormatLocal = "yyyy/m/d" '设置B1单元格为日期格式

    [c1].NumberFormatLocal = "[$-F400]h:mm:ss AM/PM" '设置C1单元格为时间格式

    [d1].NumberFormatLocal = "0.00%" '设置D1单元格为百分比格式

    [e1].NumberFormatLocal = "0.00E+00" '设置E1单元格为科学记数法格式

    [f1].NumberFormatLocal = "G/通用格式" '设置F1单元格为常规格式

11. Querytable用法
    可以快速查询数据到excel表中

Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection
Dim qt As New QueryTable
Dim strCn, strSQL As String
strCn = "Provider=sqloledb;Server=192.168.0.1;Database=TestDB;Uid=sa;Pwd=123456;"
cn.Open strCn
rs.Open strSQL, cn
Set qt = Worksheets(s_t).QueryTables.Add(rs, Worksheets("Sheet1").Range("a1"))
    With qt
    .FieldNames = True '数据源的字段名称作为返回数据的列标题显示
    .RowNumbers = False '行号作为第一列添加到指定查询表
    .FillAdjacentFormulas = False '每当查询表刷新时，指定查询表右侧的公式就自动更新
    .PreserveFormatting = True '将数据前五行的任何常用格式设置应用到查询表的新数据行
    .RefreshOnFileOpen = False '每次打开工作簿时，数据透视表高速缓存或查询表自动更新,False为不自动更新
    .BackgroundQuery = True '查询表的查询是异步执行（在后台执行）的
    .RefreshStyle = xlInsertDeleteCells '返回或设置指定工作表中的行的添加或删除方式, 以适应查询返回的 recordset 中的行数
    .SavePassword = True '将 ODBC 连接字符串中的密码信息与指定查询一起保存
    .SaveData = True '将数据透视表的数据随工作簿一起保存
    .AdjustColumnWidth = True '每次刷新指定的查询表时列宽都会自动调整为最适合的宽度
    .RefreshPeriod = 0 '设置两次刷新之间的时间间隔
    .PreserveColumnInfo = False '每次刷新查询表时，列排序、筛选和布局信息都会保留，则该值为 True。 默认值为 True 。False用于与早期版本兼容
    End With
qt.FieldNames = True'显示标题
qt.Refresh

12. 行列单元格操作
    

With Worksheets(s_t)
     .Rows("1:1").Insert'从第一行开始插入
     .Range(.Cells(1, 1), .Cells(1, icolumns)).Merge'合并单元格
     .Cells(1, 1) = "标题"'设置标题
     .Rows(1).RowHeight = 50 '行高
     .Cells(1, 1).HorizontalAlignment = xlCenter '内容居中
     .Cells(1, 1).Font.Size = 20 '字体大小
     .Cells(1, 1).Font.Bold = True '加粗
     .Columns.EntireColumn.AutoFit '根据内容调节列宽
End With

13. 分离字符和汉字

While Cells(row_number, 1) <> ""
    ys_char = Cells(row_number, 1)
    new_string = ""
    new_char = ""
    For c = 1 To Len(ys_char)
    	Char = Mid(ys_char, c, 1)'截取字符
    	If (AscW(Char) > -40870 And AscW(Char) < -19967) Or (AscW(Char) < 40870 And AscW(Char) > 19967) Then'判断是否是汉字
        	new_string = new_string + Char
    	ElseIf Char = "-" Then
        	new_string = new_string + Char
    	Else
        	new_char = new_char + Char
    	End If
    Next c
    Cells(row_number, 4) = new_char'字符写入第4列
    
    Cells(row_number, 5) = new_string'汉字存入第5列
    row_number = row_number + 1'下一行
Wend

14. 数据验证忽略空白值

=OFFSET($E$2,,,COUNTA(E:E))

COUNTA
OFFSET
参考
从E列第2行开始，E列的所有值忽略空白值

15. 对象变量或with块变量未设置

Dim MyProc As ADODB.Command
Set MyProc = New ADODB.Command '如果没有Set语句，就会报此错，用于设置传入参数
dbCon.CursorLocation = adUseClient '此句必须有，用于存储过程返回结果集
If dbCon.State = adStateOpen Then
                With MyProc
                     .ActiveConnection = dbCon
                     .Prepared = True
                     .CommandText = "GetData"
                     .CommandType = adCmdStoredProc
                     .Parameters("@begintime") = "2020-04-01"'这个参数可以用.Parameters(1)代替
                     .Parameters("2") = "2020-04-01"
                     .Parameters("3") = "A"
                     Set AdoRs = .Execute '存储过程中AS 后面必须有 SET NOCOUNT ON
                End With
            End If

16. ADO.RecordSet.RecordCount=-1的解决方法

rs.CursorLocation = 3 '加上此设置，可以解决RecordCount=-1
rs.Open strSQL, cn

参考：在VB学习中recordSet.RecordCount返回值为-1的解决办法
rs.CursorLocation=3 是什么意思

3 代表rs.CursorLocation = adUseClient
就是代表使用客户端光标,和他对应的是 rs.CursorLocation = adUseServer 服务端光标

CursorLocation 属性

设置或返回游标服务的位置。

设置和返回值

设置或返回可设置为以下某个常量的长整型值。

常量 说明
adUseNone 没有使用游标服务。（该常量已过时并且只为了向后兼容才出现）。
adUseClient 使用由本地游标库提供的客户端游标。本地游标服务通常允许使用的许多功能可能是驱动程序提供的游标无法使用的，因此使用该设置对于那些将要启用的功能是有好处的。AdUseClient 具有向后兼容性，也支持同义的 adUseClientBatch。
adUseServer 默认值。使用数据提供者的或驱动程序提供的游标。这些游标有时非常灵活，对于其他用户对数据源所作的更改具有额外的敏感性。但是，Microsoft Client Cursor Provider（如已断开关联的记录集）的某些功能无法由服务器端游标模拟，通过该设置将无法使用这些功能。
说明
该属性允许在可用于提供者的各种游标库中进行选择。通常，可以选择使用客户端游标库或位于服务器上的某个游标库。

该属性设置仅对属性已经设置后才建立的连接有影响。更改 CursorLocation 属性不会影响现有的连接。

对于 Connection 或关闭的 Recordset 该属性为读/写，而对打开的 Recordset 该属性为只读。

由 Execute 方法返回的游标继承该设置。Recordset 将自动从与之关联的连接中继承该设置。

远程数据服务用法 当用于客户端 (ADOR) Recordset 或 Connection 对像时，只能将 CursorLocation 属性设置为 adUseClient。

注：

使用RecordCount属性可确定Recordset对像中记录的数目。ADO无法确定记录数时，或者如果提供者或游标类型不支持RecordCount，则该属性返回–1。读已关闭的Recordset上的RecordCount属性将产生错误。
如果Recordset对像支持近似定位或书签（即Supports(adApproxPosition)或Supports(adBookmark)各自返回True），不管是否完全填充该值，该值将为Recordset中记录的精确数目。如果Recordset对像不支持近似定位，该属性可能由于必须对所有记录进行检索和计数以返回精确RecordCount值而严重消耗资源。
Recordset对象的游标类型会影响是否能够确定记录的数目。对仅向前游标，RecordCount属性将返回-1，对静态或键集游标返回实际计数，对动态游标取决于数据源返回-1或实际计数。

17. 请注意，您的文档的部分内容可能包含文档检查器无法删除的个人信息。
    
    解决方法：
    选项–>信任中心–》信任中心设置–>取消勾选(保存时从文件属性中删除个人信息)
    
18. 判断数据类型

IsNumeric
'判断变量的值是否为数值
isdate
'判断变量的值是否为日期
isnull
'判断变量的值是否包含任何有效数据
isempty
'判断变量的值是否为空
IsArray       
'判断出变量是否为一个数组。
IsError
'判断变量是否返回的是一个错误值
IsObject
'判断变量是否表示对象变量

19. 常用对象（Application，WorkSheet）

参考VBA常用对象

20. CopyFormRecordset用法

Dim cn  As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strSQL, strCn As String

Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset

Application.ScreenUpdating = False '禁止屏幕更新，用于所有数据更新完成之后才将数据显示在Sheet中
Application.Calculation = xlCalculationManual '计算方式改为手动

strCn = "provider=sqloledb;driver={SQL SERVER};Server=.;DataBase=Test;uid=sa;pwd=123456"

strSQL = "SELECT * FROM [TEST].[DBO].[GETDATA] WHERE T_DATE='2020-01-01' ORDER BY T_DATE"

Sheet2.Range("1:100000").Delete '删除Sheet2中的数据


cn.Open strCn
rs.CursorLocation = 3 '设置此值用于得到数据集的行数
rs.Open strSQL, cn

irows = rs.RecordCount + 1 
icolumns = rs.Fields.Count '得到列数

For i = 0 To icolumns - 1
    Sheet2.Cells(1, i + 1) = rs.Fields(i).Name '设置标题
Next

Sheet2.Range("a2").CopyFromRecordset rs '将值复制到Sheet2中

if rs.State=1 then
	rs.Close '关闭数据集对象
end if
cn.Close'关闭连接
Set rs=Nothing
Set cn=Nothing
Application.ScreenUpdating = True'开启屏幕更新
Application.Calculation = xlCalculationAutomatic'自动计算

21. 一些Application对象用法

Private Sub CheckBox1_Click()
 
'计算方式改为手动
 
Application.Calculation = xlCalculationManual
 
'关闭提示
 
Application.DisplayAlerts = False
 
'关闭屏幕刷新
 
Application.ScreenUpdating = False
 
'恢复自动计算
 
Application.Calculation = xlCalculationAutomatic
 
'开启提示
 
Application.DisplayAlerts = True
 
'开启屏幕刷新
 
Application.ScreenUpdating = True
 
End Sub
 

22. 查询超时已过期

使用VB执行数据库存储过程查询时报错，原因是没有设置连接超时
设置连接超时

ADODB.Connection.CommandTimeout = 180 '3分钟

23. 关于单元格的相同数值但VB判断值不相同的原因与解决方法
    

    就是vba比较的两个值：
    显示为2.2，实际是文本值
    显示为2.2，实际是数值
    在excel逻辑运算中，文本值>数值
    所以文本型数值2.2>数值2.2
    vba比较的时候可以转换下数据格式都为数值进行比较，
    文本型数值转数值最简单的方法就是：文本型数值*1（含空格/不可见字符的不行）
    另：isnumeric()判断是否是纯数字

24. 判断文件是否存在

'''判断文件是否存在
ys_path = ThisWorkbook.Path & "\" & ys_book_name & ".xlsx"
'''方法一，使用Dir()函数,路径需要是全路径，
'''ThisWorkbook.Path：当前文件的路径
'''Dir，常用的第二个参数16或者vbDirectory
If Dir(ys_path, 16) <> "" Then
    file_name = ys_book_name & ".xlsx"
Else
    'MsgBox ("没有对应的文件")
End If
'''方法二
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

'''调用
If IsFileExists(ys_path) = True Then
' 文件存在时的处理
    MsgBox "文件存在！"
Else
' 文件不存在时的处理
    MsgBox "文件不存在！"
End If

25. 筛选数据
    AutoFilter方法的语法及说明

下面是Range对象的AutoFilter方法的语法：

Range对象.AutoFilter(Field,Criterial1,Operator,Criteria2,VisibleDropDown)

说明：

1.参数Field，指定想要基于筛选的字段的整数偏移量。从列表的左侧算起，最左侧的字段是字段一。

2.参数Criterial1，指定判断条件（为字符串）。使用“=”查找空字段，或者使用“<>”查找非空字段。如果忽略该参数，那么判断是全部。如果参数Operator是xlTop10Items，那么参数Criterial1指定项目的数量。

3.参数Operator，指定筛选的类型，为XlAutoFilterOperator常量之一：

lxlAnd：值为1。Criteria1和Criteria2的逻辑与。

lxlOr：值2。Criteria1或Criteria2的逻辑或。

lxlTop10Items：值3。显示最大值的项（在Criteria1中指定项目数）。

lxlBottom10Items：值4。显示最小值的项（在Criteria1中指定项目数）。

lxlTop10Percent：值5。显示最大值的项（在Criteria1中指定百分比）。

lxlBottom10Percent：值6。显示最小值的项（在Criteria1中指定百分比）。

lxlFilterValues：值7。筛选值。

lxlFilterCellColor：值8。单元格的颜色。

lxlFilterFontColor：值9。字体颜色。

lxlFilterIcon：值10。筛选图标。

lxlFilterDynamic：值11。动态筛选。

4.参数Criteria2，指定第二个判断条件（字符串），使用Criterial1和Operator构建复合判断条件。

5.参数VisibleDropDown，设置为True则显示所筛选字段的自动筛选下拉箭头；设置为False则隐藏所筛选字段的自动筛选下拉箭头。默认为True。

6.如果忽略所有参数，那么AutoFilter方法简单地切换指定区域的自动筛选下拉箭头的显示。

'筛选区域A20:M20并且列7的值不为0的数据
MyBook.Sheets(1).Range("A20:M20").AutoFilter Field:=7, Criteria1:="<>" & "0"

26. 错误处理

Public sub test()
	On Error GoTo ErrMsg
		'''代码内容
		Exit Sub
	ErrMsg:
		MsgBox Err.Description''错误描述		
		Err.Clear'清除错误	
		On Error Resume Next '''直接忽略错误进行下一个语句

27. 声明常量变量

Const 常量名称 AS 类型名称 = "值"

28. 文件处理

'得到当前文件的路径
Debug.Print(ThisWorkbook.Path)
'打开文件
Workbook.Open(file_path)

29. 数组

'声明数组
'1.简单声明
Dim 数组名  (a  to   b)  as  数据类型'‘声明一个数组名为...数据容量为...的...变量
'声明数组时，也可以用一个自然数n指定数组长度，该自然数作为数组的最大索引号，但数组默认索引号是0，数组长度为n+1
'也可以如下声明
Dim 数组名(n) as 数据类型
'如果在模块的第一句写上option  base  1，尽管只使用一个自然数确定数组长度，数组起始索引号也是1
'2.根据a列动态声明
'统计A列有多少个非空单元格
n = application.worksheetfunction.count(range("a:a")) 
'重新定义数组大小，注意:已经定义大小的数组同样可以使用redim语句重新指定它的大小。
redim  arr(1  to  n) as   string  
'3.多维数组,上面主要说明了一维数组,实际运用过程中还存在二维、三维......数组，多维数组声明和使用同一维数组类似，如
arr(1 to n,1 to m, 1 to b) as string
'将列值赋值给数据
arr=Range("A1:A20")
'得到数组的上限、下限
UBound(arr)'上限
LBound(arr)'下限
UBound(arr)-LBound(arr)+1'数组个数

'将数组中的元素赋值给单元格
Dim arr() As Variant
arr=Array("a","b")
Worksheets("sheet1").Range("a3:a4").Value = arr

结果如下：

Dim arr() As Variant
arr = Array("a", "b")
Worksheets("sheet1").Range("a1:a2").Value = WorksheetFunction.Transpose(arr)

Transpose方法详解：

结果如下：

如果是(“a1:b2”)

多维数组

Dim arr(1 To 2, 1 To 4) As Variant
arr(1, 1) = 1001
arr(1, 2) = "重庆"
arr(1, 3) = "市级"
arr(1, 4) = "渝"
arr(2, 1) = 1002
arr(2, 2) = "北京"
arr(2, 3) = "市级"
arr(2, 4) = "京"
Worksheets("Sheet1").Range("A1：D2").Value = arr

以上总结为，数组的值赋值给单元格是按照数据值的顺序赋值给特定的区域，如果使用了WorksheetFunction.Transpose方法则会转置赋值

30. 复制粘贴
    
    用法，将SheetA中的值复制给SheetB

'Range对象.PasteSpecial(Paste,Operation,SkipBlanks,Transpose)
'
'参数均为可选。若没有指定参数，则直接复制。
'1.Paste 
'xlPasteType常量，指定复制的具体内容。默认为全部复制。
'
'全部 xlPasteAll
'公式 xlPasteFormulas
'数值 xlPasteValues
'格式 xlPasteFormats
'批注 xlPasteComments
'验证 xlPasteValidation
'所有使用源主题的单元 xlPasteAllUsingSourceTheme
'边框除外 xlPasteAllExceptBorders
'列宽 xlPasteColumnWidths
'公式和数字格式 xlPasteFormulasAndNumberFormats
'值和数字格式 xlPasteValuesAndNumberFormats
'所有合并条件格式 xlPasteAllMergingConditionalFormats
'2.Operation 
'xlPasteSpecialOperation常量，指明粘贴时要进行的运算操作，即将复制的单元格中的数据与指定单元格区域中的值进行加减乘除运算。
'
'无 xlPasteSpecialOperationNone
'加 xlPasteSpecialOperationAdd
'减 xlPasteSpecialOperationSubtract
'乘 xlPasteSpecialOperationMultiply
'除 xlPasteSpecialOperationDivide
'3.SkipBlanks 跳过空单元格
'
'4.Transpose 转置
'写成一行则中间加一个：
'如
 Sheets("Sheet1").Range("A1").Copy
 Sheets("Sheet2").Range("A2").PasteSpecial xlPasteFormulas
 '或者
 Sheets("Sheet1").Range("A1").Copy : Sheets("Sheet2").Range("A2").PasteSpecial xlPasteFormulas

31. 查询页签中是否包含另一个页签中某列的值

r_row = Sheets("Sheet1").Range("A2").End(xlDown).Row 
For r = 2 To r_row
    With Sheets("Sheet2").Range("a2:J1000")
        Set s_v = .Find(Sheets("Sheet1").Cells(r, "D"), LookIn:=xlValues)
        X = s_v.Row '查询到的行数
    End With
    If X > 0 Then
        Msgbox("有数据")
    End If
Next