Excel VBA 常用代码总结

将当前Excel另存为test.xls
ActiveWorkbook.SaveCopyAs  thisWorkbook.Path &" \test.xls"

自定义函数
Function youFunctionName(msg)
    youFunctionName = msg ‘定义函数返回值
End Function

显示窗体
UserForm1.Show

隐藏窗体
UserForm1.Hide

生成文本文件
Private Sub CommandButton1_Click()
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set file = fso.CreateTextFile(ThisWorkbook.Path & "\yourtext.txt", True)
    file.Write "abcd"
    file.Close
    Set file = Nothing
    Set fso = Nothing
End Sub

按键监听
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
MsgBox KeyCode ‘13表示回车键
End Sub

数组
Dim arr() As String
arr = Split("hello,world", ",")
For i = LBound(arr) To UBound(arr)
    MsgBox arr(0)
Next

查找字符串
InStr("hello,world", ",") 返回字符在字符串的位置

工作簿已使用的行数
Worksheets(1).UsedRange.Rows.Count
工作簿已使用的列数
Worksheets(1).UsedRange. Columns.Count

条件判断
If str = "" Then
End If

MySQL连接数据库
首先安装MySQL驱动，将Microsodt ActiveX Data Objects 2.0引用到工程。
1Function test(msg)
2    Dim strSQL
3    Dim conn As ADODB.Connection
4    Dim rs As ADODB.Recordset
5    Set conn = New ADODB.Connection
6    conn.Open "driver={MySQL ODBC 5.1 Driver};server=192.168.0.1;database=mysql;user=root;password=root;Option=3"
7    Set rs = New ADODB.Recordset
8    rs.Open "select sysdate();", conn, adOpenKeyset, adLockPessimistic
9    Do While Not rs.EOF
10        MsgBox rs(0)
11        rs.MoveNext
12    Loop
13    rs.Close
14    Set conn = Nothing
15    test = msg
16End Function
行1，定义函数test，输入参数msg
行3，定义ADODB连接，这里必须引用Microsodt ActiveX Data Objects 2.0
行6，根据输入数据库连接参数，打开连接
行7，定义记录集
行8，执行sql，并将结果存入记录集
行9，循环记录集
行11，将游标移至下一条
行13，关闭记录集
行14，关闭连接
行15，定义函数

遍历单元格 单元格读取
Sub test()
    Dim str
    Dim i, j
    i = 1
    j = 1
    For r = 1 To Worksheets(2).UsedRange.Rows.Count
        For c = 1 To Worksheets(2).UsedRange.Columns.Count
            str = Worksheets(2).Cells(r, c).Value
            Worksheets(3).Cells(j, 1).Value = i
            Worksheets(3).Cells(j, 2).Value = c
            Worksheets(3).Cells(j, 3).Value = str
            j = j + 1
        Next
        i = i + 1
    Next
End Sub

删除形状，同事的电脑不知道是不是中毒了，原来几十K的Excel现在变成几M，经分析发现文本框太多，多大9000多个，Excel前台无法删除，所以只好选择用代码来删除，效果还很明显。
Sub test()
    Dim sheet As Worksheet
    Dim s As Shape
    Dim i As Integer
    For Each sheet In ActiveWorkbook.Sheets
        For Each s In sheet.Shapes
            s.Delete
            i = i + 1
        Next
    Next
    MsgBox "已删除当前表中 " & i & " 形状"
End Sub

激活当前已使用区域，有个同事的Excel文件30多M，但数据应该只有2M，检查发现有太多的空白行，选中空白行删除还是不能解决问题，最好执行代码居然就可以了。
ActiveSheet.UsedRange.Select