VBA入门之实战

#一、创建工作簿

Public Sub WorkBookAdd()

    Dim Wb As Workbook, sht As Worksheet '定义一个Workbook对象变量和一个Worksheet对象变量

    Set Wb = Workbooks.Add  '创建一个工作簿并赋值给Wb变量

    Set sht = Wb.Worksheets(1)

    With sht

        .Name = "日报" '设置sheet的标签名

        .Range("A1:F1") = Array("客户号", "客户名", "逾期天数", "逾期金额", "贷款期数", "剩余本金") '设置表头

    End With

    Wb.SaveAs ThisWorkbook.Path & "\客户日报.xlsx"  '将该工作簿另存为客户日报.xlsx

    ActiveWorkbook.Close

End Sub

#二、判断文件是否打开

Public Sub JudgeOpen()

Public Sub JudgeOpen()

    Dim i As Integer '定义一个整型变量

    For i = 1 To Workbooks.Count '进行循环，次数为已打开的工作簿个数

        If Workbooks(i).Name = "客户日报.xlsx" Then '判断是否有工作簿名为“客户日报.xlsx”的工作簿

            MsgBox "文件已打开!" '

            Exit Sub '如果有的话就关闭程序

        End If

    Next

    MsgBox "文件没有打开!"

End Sub

#三、判断文件是否存在

Public Sub JudgeExist()

    Dim fil As String

    fil = ThisWorkbook.Path & "\客户日报.xlsx"

    If Len(Dir(fil)) > 0 Then '如果fil指代的文件存在则返回文件名否则为空字符串

        MsgBox "工作簿存在！"

    Else

        MsgBox "工作簿未存在！"

    End If

End Sub

#四、向未打开的工作簿中存入文件

Public Sub InputData()

    Dim wb As String, xrow As Integer, LenRow As Integer, arr 'arr的定义方式是变体变量

    wb = ThisWorkbook.Path & "\客户日报.xlsx"

    Workbooks.Open (wb) '打开客户日报

    With ActiveWorkbook.Worksheets(1)

        xrow = .Range("A1").CurrentRegion.Rows.Count + 1 '计算空白行的行数

        arr = Array(xrow - 1, "小花", "1", "1000", "12", "1888") '生成一个数组将其赋值给arr变量

        LenRow = UBound(arr) - LBound(arr) + 1 '计算arr数组的长度

        .Cells(xrow, 1).Resize(1, LenRow) = arr '将数组的值写入单元格区域中

    End With

    ActiveWorkbook.Close savechanges:=True '保存修改并关闭

End Sub

#五、对工作表进行隐藏

Public Sub Implicit()

    Dim sht As Worksheet

    For Each sht In Worksheets '对当前活动工作簿中所有的工作表进行循环

        If sht.Name <> ActiveSheet.Name Then '对名字进行判断

            sht.Visible = xlSheetVeryHidden '这种隐藏方式不能在excel中取消隐藏

        End If

    Next

End Sub

#六、用某列进行生成多个工作表

Public Sub AddSheets()

    '用B列来分表，B列有重复值

    Dim i As Integer, wb As Workbook, sht As Worksheet

    i = 2

    Set wb = Workbooks.Open(ThisWorkbook.Path & "\客户日报.xlsx")

    Set sht = wb.Worksheets("日报")

    Do While sht.Cells(i, "B").Value <> "" '判断该行是否为空

        On Error Resume Next    '从该句开始语句有误也会直接跳到下一行

        If wb.Worksheets(sht.Cells(i, "B").Value) Is Nothing Then '如果这个工作表存在则执行if中的代码

            wb.Worksheets.Add after:=Worksheets(Worksheets.Count) '添加一个工作表

            ActiveSheet.Name = sht.Cells(i, "B").Value  '将新加的工作表重命名

        End If

        i = i + 1

    Loop

End Sub

#七、对某列分类并且分到不同的表中

Sub ShtClear()

    Dim i As Long, Cont As String, rng As Range

    Dim ColLen As Single, sht As Worksheet

    ColLen = Worksheets(1).Cells(1, 16384).End(xlToLeft).Column() '获取第一列的行数

    For Each sht In Worksheets '把第一列复制到每一个表格的第一列中

        Set rng = sht.Cells(1, 1).Resize(1, ColLen)

        Worksheets(1).Range(Cells(1, 1), Cells(1, ColLen)).Copy rng

    Next

    i = 2

    bj = Cells(i, "B").Value

    Do While bj <> "" '对要分类的列的值进行判断，当单元格为空时停止

        Set rng = Worksheets(bj).Range("A65535").End(xlUp).Offset(1, 0)

        Cells(i, 1).Resize(1, ColLen).Copy rng

        i = i + 1

        bj = Cells(i, "B").Value

    Loop

End Sub

需要用到的excel模板，下载excel模板链接

#八、将工作表保存为工作簿

Sub SaveToFile()

    Application.ScreenUpdating = False

    Dim folder As String, sht As Worksheet

    folder = ThisWorkbook.Path & "\" & Worksheets(1).Name

    If Len(Dir(folder, vbDirectory)) = 0 Then 'dir的第二个参数是文件类型

        MkDir folder 'MkDir可以生成目录

    End If

    For Each sht In Worksheets

        sht.Copy '复制sht后会生成一个新的工作簿，如果该工作簿会是活动工作簿

        ActiveWorkbook.SaveAs folder & "\" & sht.Name & ".xls"

        ActiveWorkbook.Close

    Next

    Application.ScreenUpdating = True

End Sub

————————————————

原文链接：https://blog.csdn.net/xiebin6163/article/details/81676815