VBA入门之实战

这篇文章是对上一篇的VBA入门的实战总结，有助于之后自己对入门知识的运用。传送连接：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

#九、合并多表数据

//ToDo

#十、合并多工作簿数据

//ToDo