Excel VBA笔记

Excel VBA 笔记

1、Sheet表的增、删、复制

'添加100个sheet
Sub addSheet()
	Sheets.Add Count:=100
End Sub

'删除100个sheet
Sub deleteSheet()
	Dim i as integer
	'取消删除警告弹窗
    Excel.Application.DisplayAlerts = False
    For i = 1 To 100
        Sheets(1).delete
    Next
    Excel.Application.DisplayAlerts = True
End Sub

'复制sheet
Sub copySheet()
    Sheets(1).copy after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "haha"
End Sub

2、forEach的用法

不适合操作单元格，麻烦一点。
适合操作工作表

Sub forDemo()
    Excel.Application.DisplayAlerts = False
    Dim sht As Worksheet
    For Each sht In Sheets
        If sht.Name <> "不能删" Then
            sht.delete
        End If
    Next
    Excel.Application.DisplayAlerts = True
End Sub

3、操作文件

Sub openFile()
    '关闭屏幕更新，后台运行。
    Application.ScreenUpdating = False
    '关闭屏幕警告
    Application.DisplayAlerts = False
    Workbooks.Open Filename:="文件绝对路径"
    ActiveWorkbook Sheets(1).Range("a1") = "啦啦啦"
    ActiveWorkbook.Save
    Workbooks.Add
    ActiveWorkbook.Sheets(1).Range("a2") = "哈哈新建的"
    ActiveWorkbook.SaveAs Filename:="文件保存路径"
    ActiveWorkbook.Close
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

4、操作单元格对象

Sub test()
    'Range("A1") = "a"
    'Sheets(Range("A1").Value).Select
    
    'A1单元格向下移10格，向右移1格
    Range("A1").Offset(10, 1) = "haha"
    
    'Debug.Print Range("C10").End(xlUp)
    '选中A10整行
    Range("A10").EntireRow.Select
    Range("A10").EntireRow.Delete
    Range("A10").EntireRow.Copy Range("A12")
    '以C10为基准，取19行，10列
    Range("C10").Resize(19, 10).Select
    Range("A10:B19").Copy Range("C10")
    '清空单元格
    Sheets(i).Range("A2:F10000").ClearContents
End Sub

5、用户信息交互:加载宏多文件操作、对话框

Sub test()
    Dim str As String
    Dim wb As Workbook
    Dim sht As Worksheet
    Dim arr()
    'application的InputBox方法可以限制类型。而普通的InputBox函数不能指定
    'str = Application.InputBox("请输入", , , , , , , 1 + 2)
    '获取要打开文件的路径(限制只能看到.xls和.xlsx文件)  2指默认第2个，即表2
    str = Application.GetOpenFilename("Excel文件,*.xls*", 2)
    Debug.Print str
    'True；指 多选
    arr = Application.GetOpenFilename("Excel文件,*.xls*", 2, , , True)
    Debug.Print UBound(arr)
    '新建一个工作簿
    Set wb1 = Workbooks.Add
    If str <> "False" Then
        '打开文件
        Set wb = Workbooks.Open(str)
        For i = LBound(arr) To UBound(arr)
            Set wb = wokbooks.Open(arr(i))
            For Each sht In wb.Sheets
                'ThisWorkbook 指当前运行宏的工作簿。加载宏.xla文件中不要使用ThisWorkbook，可以用ActiveWorkbook
                'sht.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count)
                'ThisWorkbook.Sheets(Thisworkbook.Sheets.count).Name = Split(wb.Name, ",")(0) & sht.Name
                sht.Copy after:=ThisWorkbook.Sheets(wb1.Sheets.count)
                ThisWorkbook.Sheets(wb1.Sheets.count).Name = Split(wb.Name, ",")(0) & sht.Name
            Next
            wb.Close
        Next
        
    'Application.Dialogs    操作Excel中的所有对话框
    End If
    
End Sub