VBA筆記10：技巧與案例

1.創(chuàng)建新的工作簿

知識(shí)點(diǎn)：Workbook、Worksheet翘魄、SaveAs

Sub WbAdd()
    '創(chuàng)建1個(gè)名為"員工花名冊(cè)"的工作簿鼎天，并保存到本工作簿所在的文件夾中
    Dim Wb As Workbook, sht As Worksheet '定義一個(gè)Workbook對(duì)象和一個(gè)Worksheet對(duì)象
    Set Wb = Workbooks.Add               '新建一個(gè)工作簿
    Set sht = Wb.Worksheets(1)
    With sht
        .Name = "花名冊(cè)"        '修改第1個(gè)工作簿的標(biāo)簽名
        '設(shè)置表頭
        .Range("A1:F1") = Array("序號(hào)", "姓名", "性別", "出生年月", "參加工作時(shí)間", "備注")
    End With
    Wb.SaveAs ThisWorkbook.Path & "\員工花名冊(cè).xlsx"  '保存到當(dāng)前工作簿所在路徑
    ActiveWorkbook.Close
End Sub

2.工作簿是否已打開

知識(shí)點(diǎn)：For循環(huán)、Exit Sub暑竟、Workbooks.Count

Sub IsOpen()
    Dim i As Integer
    For i = 1 To Workbooks.Count
        If Workbooks(i).Name = "VBA練習(xí)_Range.xlsm" Then
            MsgBox "文件已打開"
            Exit Sub
        End If
    Next
    MsgBox "文件沒打開"
End Sub

3.工作表是否存在斋射、創(chuàng)建&移動(dòng)

知識(shí)點(diǎn)：For Each循環(huán)、Move

Sub IsOpen3()
    Dim sht As Worksheet
    For Each sht In Worksheets
        If sht.Name = "測(cè)試工作表" Then
            MsgBox "Yes"
            Worksheets("測(cè)試工作表").Move before:=Worksheets(1)
            Exit Sub
        End If
    Next
    MsgBox "None"
    Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "測(cè)試工作表"
End Sub

另一種寫法但荤，知識(shí)點(diǎn)：On Error Resume Next罗岖、Is Nothing
注意：Is Nothing配合If語(yǔ)句肯定會(huì)報(bào)錯(cuò)（下標(biāo)越界），所以才加了On Error Resume Next

Sub IsOpen4()
    On Error Resume Next '當(dāng)出現(xiàn)報(bào)錯(cuò)的時(shí)候腹躁，繼續(xù)執(zhí)行程序
    If Worksheets("測(cè)試工作表") Is Nothing Then
        Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "測(cè)試工作表"
    Else
        Worksheets("測(cè)試工作表").Move before:=Worksheets(1)
    End If
End Sub

4.向未打開的工作簿里錄入數(shù)據(jù)

知識(shí)點(diǎn)：With語(yǔ)句桑包、CurrentRegion、Resize纺非、:=

Sub WbInput()
    Dim wb As String, xrow As Integer, arr
    wb = ThisWorkbook.Path & "\員工花名冊(cè).xlsx"
    Workbooks.Open (wb)
    With ActiveWorkbook.Worksheets(1)
        xrow = .Range("A1").CurrentRegion.Rows.Count + 1
        arr = Array(xrow - 1, "張敏", "女", #7/8/1987#, #9/1/2010#, "10年新招")
        .Cells(xrow, 1).Resize(1, 6) = arr
    End With
    ActiveWorkbook.Close savechanges:=True
End Sub

CurrentRegion

以單元格為原點(diǎn)哑了，返回一個(gè)邊緣是任意空行和空列組合成的范圍，配合Rows.Count(行數(shù))烧颖、Columns.Count(列數(shù))弱左、Cells.Count(單元格數(shù))，可以實(shí)現(xiàn)索引炕淮、定位的作用

需要再深入挖一下這屬性的用法

運(yùn)算符" := "

:=和=在VBA里拆火，都是賦值符，前者是用來(lái)給方法內(nèi)部的參數(shù)賦值用涂圆，后者是用來(lái)給變量賦值的

5.表格數(shù)據(jù)分類

表格數(shù)據(jù)如下

image.png

需求：根據(jù)C列的數(shù)據(jù)榜掌，創(chuàng)建對(duì)應(yīng)名稱的獨(dú)立工作表（排重）

知識(shí)點(diǎn)：Do While語(yǔ)句

Sub ShtAdd()
    Dim i As Integer, sht As Worksheet
    i = 2
    Set sht = Worksheets("花名冊(cè)")
    Do While sht.Cells(i, "C").Value <> ""
        On Error Resume Next
        If Worksheets(sht.Cells(i, "C").Value) Is Nothing Then
            Worksheets.Add after:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = sht.Cells(i, "C").Value
        End If
        i = i + 1
    Loop
End Sub

需求：將對(duì)應(yīng)性別的數(shù)據(jù)，存放到對(duì)應(yīng)的工作表里