一、物件模型

在VBE中“幫助（H）”——“Microsoft Visual Basic 幫助（H） F1”——“Visual Basic 語言參考”——“函式” 或者在VBE下快捷鍵“F1”

地址：https://docs.microsoft.com/zh-cn/office/vba/api/overview/excel/object-model

二、Application物件（Excel頂層物件）

1、ScreenUpdating屬性

是否控制螢幕更新，False表示關閉螢幕更新，True表示開啟螢幕更新

設定ScreenUpdating=False 關閉螢幕更新，將看不到程式的執行過程，可以加快程式的執行速度，讓程式顯得更直觀，專業。

示例（為關閉螢幕更新下，會彈出對話方塊）：

Sub InputTest()
    Cells.ClearContents '清除表中所有資料
    Range("A1:A10") = 100
    MsgBox "剛才在A1:A10輸入數值100，你能看到結果嗎？"
    Range("B1:B10") = 200
    MsgBox "剛才在B1:B10輸入數值200，你能看到結果嗎？"
End Sub
 

示例（關閉螢幕更新，看不到執行過程，程式最終執行完成才能看到最終結果）

Sub InputTest()
    Cells.ClearContents '清除表中所有資料
    Application.ScreenUpdating = False '關閉螢幕更新
    Range("A1:A10") = 100
    MsgBox "剛才在A1:A10輸入數值100，你能看到結果嗎？"
    Range("B1:B10") = 200
    MsgBox "剛才在B1:B10輸入數值200，你能看到結果嗎？"
    Application.ScreenUpdating = True '恢復螢幕更新
End Sub
 

2、DisplayAlterts屬性

是否顯示警告對話方塊，False為不顯示，True為顯示

Sub delSht()
    Dim sht As Worksheet
    Application.DisplayAlerts = False '不顯示警告資訊
    For Each sht In Worksheets
        If sht.Name = ActiveSheet.Name Then '判斷sht是不是活動工作表
            sht.Delete '刪除sht代表的工作表
        End If
    Next
    Application.DisplayAlerts = True '恢復顯示警告資訊
End Sub

3、EnableEvents屬性

啟用或禁用事件，False為禁用（不讓事件發生），True為啟用

什麼是事件？能被Excel認識的一個操作動作，例如“開啟工作簿”、“關閉工作簿”等

• 示例1：編寫一個程式，當選中工作表的單元格時，自動在單元格中寫入該單元格的地址

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Target.Value = Target.Address
End Sub

• 示例2：選中活動單元格，記錄對應單元格地址，並將活動單元格向下移動一個單元格

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Target.Value = Target.Address
    Application.EnableEvents = False '禁用事件
    Target.Offset(1, 0).Select '選中活動單元格下面的一個單元格
    Application.EnableEvents = True '啟用事件
End Sub

4、WorksheetFunction屬性

使用WorksheetFunction呼叫Excel內建函式

• 示例1：統計A1:A50單元格中數值大於1000的單元格有多少個？

Sub CountTest()
    Dim mycount As Integer, rng As Range
    For Each rng In Range("A1:B50")
        If rng.Value > 1000 Then mycount = mycount + 1
    Next
    MsgBox "A1:B50中大於1000的單元格個數為:" & mycount
End Sub

• 示例2：統計A1:A50單元格中數值大於1000的單元格有多少個？使用COUNTIF函式

Sub CountTest()
    Dim mycount As Integer
    mycount = Application.WorksheetFunction.CountIf(Range("A1:B50"), ">1000")
    MsgBox "A1:B50中大於1000的單元格個數為:" & mycount
End Sub

5、給Excel梳妝打扮

• Excel工作表介面相關命令

• Excel介面

6、Application的常用屬性

三、Workbook物件

Workbook工作簿

Workbooks工作簿集合

1、怎麼引用工作簿

引用工作簿，就是指明工作簿的位置及名稱，共有兩種方式

方式一：利用索引號引用工作簿，Workbook.Item(3)，這裡的Item可以省略，即Workbook(3)

方式二：利用工作簿名稱引用 ，Workbook("Book1")或Workbook("Book1.xls")，如果本地檔案顯示拓展名（且檔案已經儲存），則檔名必須帶拓展名，否則會報錯。

2、Workbook名片資訊

Sub wbMsg()
    Range("B2") = ThisWorkbook.Name     '返回當前工作簿名稱 練習 -副本.xlsm
    Range("B3") = ThisWorkbook.Path     '返回當前工作簿路徑 C:\Users\ThinkPad\Desktop
    Range("B4") = ThisWorkbook.FullName '返回當期工作簿帶名稱的路徑 C:\Users\ThinkPad\Desktop\練習 - 副本.xlsm
End Sub

3、建立工作簿

• 使用方法：Workbooks.Add

　　如果不帶任何引數，將建立包含一定數目空白工作表的新工作簿（數目由SheetsInNewWorkbook屬性決定）

• 也可以給Add方法設定引數(引數表示現有Excel名稱的字串，選用該引數，新建的工作簿將以該檔案作為模板)

　　Workbooks.Add "C:\Program Files\Microsoft Office\Templates\2052\ADDRESS\ADDRESS.XLS"

• 也可以通過引數指定新建工作簿中包含的工作型別

　　Workbooks.Add xlWBATChart '新建圖表工作表

• Excel一共有4種類型的工作表

　　可以在插入對話方塊裡看到(選中工作表名稱——滑鼠右鍵單擊——插入——即可顯示)，如圖（包含引數說明）：

　　

4、開啟工作簿

使用Workbooks的Open方法（引數名要寫含路徑的名稱）

Sub OpenFile()
    Workbooks.Open Filename:="F:\Book1.xls"
End Sub

引數名成可以省略不寫(Open除了Filename引數外，還有14個引數，讓使用者決定以何種方式開啟指定的檔案，可以通過系統的幫助來檢視更多的資訊)

Sub OpenFile()
    Workbooks.Open "F:\Book1.xls"
End Sub

5、啟用工作簿

同事開啟多個工作簿，但是同一時間只能有一個視窗是活動的，呼叫Workbooks物件的Active方法可以啟用一個工作簿。

Sub JhWb()
    Workbooks("Book1.xls").Activate '啟用工作簿
End Sub

6、儲存工作簿

儲存工作簿呼叫Workbooks的Save方法

Sub SaveWb()
    ThisWorkbook.Save   '儲存程式碼所在的工作簿
End Sub

如果想將檔案另存為一個新的檔案，或者第一次儲存一個新建的工作簿，就用SaveAs方法。

引數指定檔案儲存的路徑及檔名如果省略路徑，則預設將檔案儲存在當前資料夾中

Sub SaveWb()
    ThisWorkbook.SaveAs Filename:="D:\test.xls"
End Sub

使用SaveAs方法將工作簿另存為新檔案後，將自動關閉原檔案，開啟新檔案，如果希望繼續保留原檔案不開啟新檔案，可以用SaveCopyAs方法

Sub SaveWb()
    ThisWorkbook.SaveCopyAs Filename:="D:\test.xls"
End Sub

7、關閉工作簿

關閉工作簿使用Workbooks的Close方法，如果不帶引數，則關閉所有開啟的工作簿

Sub CloseWb()
    Workbooks.Close '關閉所有開啟的工作簿
End Sub

如果想關閉指定的工作簿，需要指定引數

Sub CloseWb()
    Workbooks("Book1.xls").Close  '關閉Book1.xls
End Sub

如果關閉之前被更改過的內容沒有儲存，關閉工作簿前Excel會詢問使用者是否儲存更改，如果不想顯示該對話方塊，可以給Close方法設定引數：

Sub CloseWb()
    Workbooks("Book1.xls").Close savechanges:=True '關閉並儲存Book1.xls
End Sub

關閉並儲存的引數savechanges也可以省略不寫：

Sub CloseWb()
    Workbooks("Book1.xls").Close True '關閉Book1.xls
End Sub

8、ThisWorkbook與ActiveWorkbook

同是Application物件的屬性，同是返回Workbook物件，但二者並不是等同的。

ThisWorkbook是對程式所在的工作簿的引用

ActiveWorkbook是對活動工作簿的引用

新建的工作簿總會成為活動工作簿

Sub wb()
    Workbooks.Add
    MsgBox "程式碼所在的工作簿為：" & ThisWorkbook.Name & Chr(13) _
            & "當前活動工作簿為：" & ActiveWorkbook.Name
    ActiveWorkbook.Close savechanges:=False
End Sub

四、Worksheet物件

Worksheet表示一張普通的工作表，Worksheets表示多個Worksheet物件的集合。

1、引用工作表

可以使用工作表的索引號或者標籤名稱引用它

Worksheets.Item (1)     '引用工作表裡的第一張工作表
Worksheets (1)          '引用工作表裡的第一張工作表
Worksheets ("Sheet1")   '引用工作簿裡標籤名稱為"Sheet1"的工作表

　　因為程式碼名稱只能在【屬性視窗】裡修改，不會隨著工作表標籤名稱或索引號的變化而變化。因此，當工作表的索引號或標籤名稱經常變化時，使用程式碼名稱引用工作表會更方便。

　　使用程式碼名稱引用工作表，只需直接寫程式碼名稱

　　例如：第一張工作表的A1單元格輸入100，程式碼為：Sheet1.Range("A1")=100

　　檢視工作表的程式碼名稱，可以讀取它的CodeName屬性，如果想知道活動工作表的程式碼名稱，程式碼為：

Sub ShowShtCode()
    MsgBox ActiveSheet.CodeName
End Sub

2、新建工作表

新建工作表使用Worksheets的Add方法

• 不帶任何引數，將在活動工作表新建一張工作表

　　Worksheets.Add

• 可以用引數給新建的工作表指定位置

　　Worksheets.Add before:=Worksheets(1) '在第一張工作表前插入一張新的工作表

　　Worksheets.Add after:=Worksheets(1) ‘在第一張工作表後插入一張新的工作表

• 還可以同時插入多張工作表

　　Worksheets.Add Count:=3 '在活動工作表前插入3張工作表，Count引數的預設值為1

• 可以同時使用多個引數，不同引數之間用英文逗號隔開

Sub shtAdd()
    Worksheets.Add after:=Worksheets(1), Count:=3
End Sub

　　在最後一張工作表後插入兩張工作表

Sub shtAdd()
    '在最後一個工作表後插入兩張工作表
    Worksheets.Add before:=Worksheets(Worksheets.Count), Count:=2
End Sub

• Add方法有哪些引數？請看VBE的提示

　　

3、更改工作表標籤名稱

• 更改工作表標籤名稱，設定工作表Name屬性

　　Worksheets(2).Name="工資表" '更改第二張工作表的標籤名稱為“工資表”

• 新建工作表時在程式中更改標籤名稱

Sub shtAdd()
    Worksheets.Add Before:=Worksheets(1)
    ActiveSheet.Name = "工資表"
End Sub

• 新建工作表同時指定它的標籤名稱

Sub shtAdd()
    '在第一張工作表前插入一個名稱為“工資表”的工作表
    Worksheets.Add(before:=Worksheets(1)).Name = "工資表"
End Sub

• 如果同時新增多張工作表（即Count引數值大於1），並不能使用一句程式碼同時命名

4、刪除工作表

刪除工作表使用Worksheets物件的Delete方法

Worksheets("Sheet1").Delete '刪除Sheet1工作表

5、啟用工作表

啟用工作表可以使用Activate方法和Select方法

Worksheets(1).Activate '啟用第一張工作表
Worksheets(1).Select '啟用第一張工作表

6、複製工作表

複製工作表使用Copy方法

Sub shtCopy()
    '這裡的工作表名稱一定要存在，否則執行會報錯
    Worksheets("工資條").Copy  '不帶引數   複製工作表，同時新建工作簿用於存放copy來的工作表（未儲存狀態）
    Worksheets("工資條").Copy before:=Worksheets("Sheet1") '帶引數  複製工作表，存放在當前工作簿的工作表Sheet1之前
    Worksheets("工資條").Copy after:=Worksheets("Sheet1") '帶引數   複製工作表，存放在當前工作簿的工作表Sheet1之後
End Sub

7、移動工作表

移動工作表與複製工作表類似，使用方法Move

Sub shtMove()
    Worksheets("工資條").Move   '不指定引數，將把工作表移動到新的工作簿中（新建工作簿）
    Worksheets("工資條").Move before:=Worksheets("Sheet1") '複製工作表，存放在當前工作簿的工作表Sheet1之前
    Worksheets("工資條").Move after:=Worksheets("Sheet1") '複製工作表，存放在當前工作簿的工作表Sheet1之後
End Sub

8、隱藏和顯示工作表

使用工作表的Visible屬性顯示或隱藏工作表

'以下這三行程式碼作用一樣，等同於從【格式】選單中隱藏工作表
Worksheets("工資條").Visible = False
Worksheets("工資條").Visible = xlSheetHidden
Worksheets("工資條").Visible = 0

用下面方法隱藏的工作表，跟上面3種方法不一樣，且通過這種方法隱藏的工作表，無法通過選單取消隱藏，只能通過VBA在屬性視窗設定或者用程式碼取消隱藏

Worksheets("工資條").Visible = xlSheetVeryHidden
Worksheets("工資條").Visible = 2

無論以何種方式隱藏了工作表，都可以用如下程式碼中的任意一句顯示它

Worksheets("工資條").Visible = True
Worksheets("工資條").Visible = xlSheetVisible
Worksheets("工資條").Visible = 1
Worksheets("工資條").Visible = -1

9、獲取工作表的數目

使用Worksheets.Count

Dim mycount%
mycount=Worksheets.Count 

10、Sheets與Worksheets

• 不同的命令，返回相同的結果

Sheets(2).Name
Worksheets(2).Name

Sheets.Count
Worksheets.Count

• 分別代表兩種不同的集合

　　Excel裡共有4中不同型別的工作表，Sheets表示公祖不裡所有型別的工作表的集合，而Worksheets只表示普通工作表的集合。
　　Sheets和Worksheets集合裡的物件都有標籤名稱Name、程式碼名稱CodeName、索引號Index等屬性，也有Add、Delete、Copy和Move等方法，設定屬性和呼叫方法類似。但是因為Sheets集合包含更多型別的工作表，所有其包含的方法和屬性比Worksheets集合多。

五、Range物件

1、Worksheet(或Range)物件的Range屬性

• 引用單元格並賦值

Worksheets("sheet1").Range("A1").Value=50

Sub rng()
    Range("A1:A10").Value = 200 '在活動工作表的A1:A10輸入值為200
    
    Dim n As String
    n = "B1:B10"
    Range(n) = 100 '在活動工作表的B1:B10輸入值為100
End Sub

• 通過設定“單元格區域名稱”呼叫Range

Sub rng()
    Range("date").Value = 200
End Sub

• 引用多個不連續的區域，用逗號隔開

Sub rng()
    Range("A1:A10,A4:E6,C3:D9").Value = 200
End Sub

• 用空格而不是逗號，則表示選中區域交集部分

Sub rng()
    Range("A1:B10 A4:D9").Value = 200
End Sub

2、Worksheet(或Range)物件的Cells屬性

• 指定單元格

Sub shtCells()
    ActiveSheet.Cells(3, 4).Value = 20  '在第3行，第4列香蕉的單元格輸入20
    ActiveSheet.Cells(3, "D").Value = 30 '在第3行，第D列相交的單元格輸入30
    
    Range("B3:F9").Cells(2, 3) = 40 '在區域“B3:F9”區域中的第2行，第3列相交的單元格，即D4
    ActiveSheet.Cells(2).Value = 50 '在活動工作表的第二個單元格輸入50,這裡使用的數字2是單元格序號，序號是按照單元格區域內由左向右遞增
    
    '選中活動工作表的A1:E10
    Range(Cells(1, 1), Cells(10, 5)).Select
    
    '以下兩個語句等價
    Range("A1", "E10").Select
    Range(Range("A1"), Range("E10")).Select
End Sub

• 全部單元格

Sub shtCells()
    ActiveSheet.Cells.Select  '選中活動工作表的所有單元格
    Range("B3:E9").Select '選中活動工作表中B3:E9單元格區域
End Sub

• 更簡短的快捷方式

Sub shtCells()
    [A1] = 10
    [A1:B10] = 20
    [B3:D10 A4:G8] = 100 '公共交叉區域，如果兩個區域引數沒有逗號，表示一個引數，而引數表示的區域沒有交集的話會報錯
    [A1:A10,C1:C10,E1:E10] = 200 '合併區域
    [area] = 300 '名稱are代表單元格，即單元格名稱為area
End Sub

　　[]是Application物件的Evaluate方法的簡寫形式，這種簡寫形式非常適合飲用一個固定的Range物件，但是因為不能再方括號中使用變數，所以這種引用方式缺少靈活性。

4、其他獲取單元格的方式（除了Range、Cells外）—Rows

ActiveSheet.Rows '選中活動工作表的所有行
ActiveSheet.Rows(3).Select '選中活動工作表的第3行
ActiveSheet.Rows("3:3").Select '選中活動工作表的第3行
ActiveSheet.Rows("3:5").Select '選中活動工作表的第3行到第5行
Rows("3:10").Rows("1:1").Select '選中第3行到第10行區域內的第一行

5、其他獲取單元格的方式（除了Range、Cells外）—Columns

ActiveSheet.Columns  '選中活動工作表的所有列
ActiveSheet.Columns (6) '選中活動工作表中的第6列
ActiveSheet.Columns ("F:G") '選中活動工作表中的F至G列
Columns("B:G").Columns("B:B").Select '選中B:G區域中的第2列

6、Application的Union方法

Union方法像一支強烈的粘合劑，將不連續的多個單元格區域粘在一起，可以同時對其進行操作。

Sub rngUnion()
    Application.Union(Range("A1:A10"), Range("D1:D5")).Select '入參至少為2個區域，至多30個區域，區域之間用逗號分隔
    Union(Range("A1:A10"), Range("D1:D5")).Select  'application可以省略不寫
End Sub

7、Range物件的Offset屬性

Offset屬性用來基於基於單元格的位置移動

Offset(x,y)兩個引數，x表示行移動，即x>0表示向下移動，x<0表示向上移動；y表示列移動，即y>0表示向右移動，y<0表示向左移動。

引數移動方向示意圖：

Sub rngOffset()
    Range("A1").Offset(2, 3).Value = 500 '基於“A1”單元格，向下移動2行，向右移動3列
    Range("C5:D6").Offset(-3, 0).Select '在“C5：D6”區域的基礎上，向上移動3行，列方向引數為0，不移動。
End Sub

8、Range物件的Resize屬性

使用Range物件的Resize屬性擴大或縮小指定的單元格區域，得到一個新的單元格區域。

Resize共有兩個引數，第一個引數確定新區域的行數，第二個引數確定新區域的列數，兩個引數的值都是正整數，最小為1.

新區域把該物件最左上角的單元格當成自己左上角第一個單元格

Sub rngResize()
    '將B2單元格擴大為B2:E6
    Range("B2").Resize(5, 4).Select
    
    '將B2：E6單元格縮小為B2：B3，新區域以B2單元格為最左上角單元格
    Range("B2:E6").Resize(2, 1).Select
    '上句等同於
    Range("B2:E6").Cells(1).Resize(2, 1).Select
End Sub

9、Worksheet物件的UsedRange屬性

UsedRange屬性返回工作表中已經使用的單元格圍成的矩形區域（不管這些區域間是否有空行，空列或空單元格）。

Sub rngUsed()
    ActiveSheet.UsedRange.Select
End Sub

10、Range物件的CurrentRegion屬性

CurrentRegion返回當前區域，即以空行和空行的組合為邊界的區域

Sub rngUsed()
    Range("D3").CurrentRegion.Select
End Sub

11、Range物件的End屬性

End屬性返回當前區域結尾處的單元格，等同於在源單元格按<End+方向鍵（上下左右）>得到的單元格。

Sub rngEnd()
    Range("E5").End(xlUp).Select
End Sub

共有4個引數，說明如下：

什麼情況會用到End屬性？工作表中記錄的行數隨時都在變化，應該把新記錄寫入工作表的第5行還是第10行？

可以用End屬性解決這個問題

Sub rngEnd()
    '取第一個單元格，如果非空則向下移動一個單元格，否則不移動。對新單元格進行賦值
    Dim c As Range
    Set c = ActiveSheet.Range("A65536").End(xlUp)
    If c.Value <> "" Then
        Set c = c.Offset(1, 0)
    End If
    c.Value = "張青"
End Sub


Sub rngUsed()
    '取使用區域內行數增加1，對該行的A列進行賦值
    Dim xrow As Long
    xrow = ActiveSheet.UsedRange.Rows.Count + 1
    Cells(xrow, "A").Value = "張青"
End Sub


Sub rngCurr()
    '取當前區域內行數增加1，對該行的A列進行賦值
    Dim xrow As Long
    xrow = Range("A1").CurrentRegion.Rows.Count + 1
    Cells(xrow, "A").Value = "張青"
End Sub

六、操作單元格，還需要了解

1、單元格內容-Value

Range("A1:B2").Value = "abc"
Range("A1:B2") = "abc"  'Value是Range的預設屬性，在給區域賦值時可以省略。

2、單元格個數-Count

Range("B4:F10").Count   '統計單元格數量
ActiveSheet.UsedRange.Rows.Count '統計活動單元格的行數
ActiveSheet.UsedRange.Columns.Count  '統計活動單元格的列數

3、單元格地址-Address

MsgBox "當前選中的單元格地址為"&Selection.Address

4、選中單元格-Active與Select

以下兩組程式碼是等效的。

ActiveSheet.Range("A1:B10").Select
ActiveSheet.Range("A1:B10").Activate

5、選擇性清除單元格-Clear

Range("B2:B15").Clear '清除B2:B15單元格所有內容（包括批註、內容、註釋、格式等）
Range("B2:B15").ClearComments '清除B2:B15單元格批註
Range("B2:B15").ClearContents '清除B2:B15單元格內容
Range("B2:B15").ClearFormats '清除B2:B15單元格格式

6、複製&貼上單元格區域-Copy&Paste

• 錄製複製和貼上的巨集內容如下：

Sub Macro1()
    Range("A1").Select
    Selection.Copy
    Range("C1").Select
    ActiveSheet.Paste
End Sub

• 但在執行復制或者貼上操作之前並不需要選中單元格，所以程式碼可以簡化為：

Sub Macro1()
    Range("A1").Copy Range("C1") 'A1是源單元格，C1是目標單元格
End Sub

• 帶引數的複製-Destination

Sub Macro1()
    Range("A1").Copy Destination:=Range("C1") 'A1是源單元格，C1是目標單元格,Destination是目標
End Sub

• 帶引數的複製-CurrentRegion

要複製的單元格區域不能確定大小，可以只指定一個單元格作為目標區域的最左上角單元格

Sub Macro1()
    Range("A1").CurrentRegion.Copy Range("C1") 'A1是源單元格，C1是目標單元格,Destination是目標
End Sub

• 想貼上源區域的數值（以下兩個式子等價）

Sub rngCopyValue_1()
    Range("A1:A10").Copy
    Range("F1:F10").PasteSpecial Paste:=xlPasteValues '僅貼上數值
End Sub
Sub rngCopyValue_2()
    Range("A1:A10").Value = Range("F1:F10").Value
End Sub

7、剪下單元格-Cut

Sub rngCut()
    Range("A1:A5").Cut Destination:=Range("G1") '把A1:A5剪下到G1:G5，這裡G1表示以G1為左上角第一個單元格的區域
    Range("F6:F10").Cut Range("G6") '把F1:F10剪下到G6:K10，引數Destination可以省略
End Sub

8、刪除單元格-Delete

Delete有4個選項，分別對應如下引數：

Range("B5").Delete Shift:=xlToLeft '刪除B5單元格，刪除後右側單元格左移
Range("B5").Delete Shift:=xlUp '刪除B5單元格，刪除後下方單元格上移
Range("B5").EntireRow.Delete '刪除B5單元格所在的行
Range("B5").EntireColumn.Delete '刪除B5單元格所在的列

9、單元格名稱，Names集合

Excel中定義的名稱就是給單元格區域（或數值、常量、公式）取的名字，一個自定義的名稱及時一個Name物件，Names是工作簿中定義的所有名稱的集合。

• 新建名稱

錄製的巨集告訴我們，怎樣新建一個名稱

'Add新建名稱的方法，RefersToR1C1表示使用R1C1引用樣式
ActiveWorkbook.Names.Add Name = "date", RefersToR1C1:="Sheet1!R5C[-2]"

R5C[-2]說明：R後面的數值表示行號，C後面的數值表示列號，[]中括號表示相對引用，預設是絕對引用，相對應用時R>0表示向下移動，C>0表示向右移動

R[2]C[3]：對活動單元格下方的第二行與右邊的第3列相交的單元格的引用

R2C3：對工作表中第二行與第3列相交的單元格的引用

• 另一種單元格引用方式：A1樣式引用

'Add新建名稱的方法，RefersToR1C1表示使用A1引用樣式,$表示相對絕對引用，將把活動單元格當做A1單元格
ActiveWorkbook.Names.Add Name = "date", RefersTo:="Sheet1$B$4"

• 定義名稱更簡單的方式

Range("A1:C10") = "date"

• 怎樣引用名稱

ActiveWorkbook.Names("date").Name = "姓名"
ActiveWorkbook.Names("姓名").Name = "張三"

• 也可以使用名稱索引引用名稱

Sub UseName()
    Dim i, mx As Integer
    mx = ActiveWorkbook.Names.Count '統計一共有多少個單元格
    For i = 1 To mx
        activateworkbook.Names(i).Visible = False '隱藏名稱
    Next
End Sub

10、單元格批註，Comment物件

一個批註就是一個Comment物件，Comments是工作簿中所有Comment物件的集合

• 給單元格增加批註

Range("B5").AddComment Text:="我用VBA新建的批註"

• 怎麼知道單元格是否有批註

Sub wbComment()
    Range("B5").AddComment Text:="我用VBA新建的批註"
    If Range("B5").Comment Is Nothing Then '判斷是否存在Comment物件
        MsgBox "B5單元格中沒有批註"
    Else
        MsgBox "B5單元格中已有批註"
    End If
End Sub

• 操作批註

Sub operComment()
    Range("B5").AddComment Text:="我用VBA新建的批註" '新建批註
    Range("B5").Comment.Visible = False '隱藏B5單元格批註
    Range("B5").Comment.Delete '刪除B5單元格批註
End Sub

11、給單元格化妝

• 設定字型-Font

Sub FontSet()
    With Range("A1:L1").Font
        .Name = "宋體" '設定字型為宋體
        .Size = 12 '設定字號為12號
        .Color = RGB(255, 0, 0) '設定字型顏色為紅色
        .Bold = True '設定字型加粗
        .Italic = True '設定字型傾斜顯示
        .Underline = xlUnderlineStyleDouble 'feud文字新增雙下劃線
    End With
End Sub

• 給單元格增加底紋-Interior

Sub InteriorSet()
    Range("A1:L1").Interior.Color = RGB(255, 255, 0) '增加黃色底紋
End Sub

• 給表格設定表框

Sub InteriorSet()
    With Range("A1").CurrentRegion.Borders
        .LineStyle = xlContinuous '設定單線邊框
        .Color = RGB(0, 0, 255) '設定邊框顏色
        .Weight = xlHairline '設定邊框線條樣式
    End With
End Sub

• 其他設定

　　可以在“單元格格式”對話方塊中進行其他設定，如果想用程式碼實現而不知道程式碼怎麼寫，可以手動操作，用巨集錄製器錄下它。

七、典型的技巧與示例

1、編寫一個程式，按要求創求的一個新的工作簿，並把它儲存到指定的資料夾。

Sub wbAdd()
    '程式建立“員工花名冊”工作簿，儲存在本工作簿所在的資料夾中
    Dim wb As Workbook, sht As Worksheet '定義一個Workbook物件和一個Worksheet物件
    Set wb = Workbooks.Add '新建一個工作簿
    Set sht = wb.Worksheets(1)
    With sht
        .Name = "花名冊"  '修改第一張工作表的標籤名稱
        .Range("A1:F1") = Array("序號", "姓名", "性別", "出生年月", "參加工作時間", "備註") '設定表頭
    End With
    wb.SaveAs ThisWorkbook.Path & "\員工花名冊.xls" '儲存新建的工作表到本工作簿所在的資料夾中
    ActiveWorkbook.Close '關閉新建的工作簿
End Sub

2、判斷工作簿是否開啟

• 工作簿是否開啟判斷

'判斷"成績表.xls"工作簿是否開啟
Sub isWbOpen()
    Dim i As Integer
    For i = 1 To Workbooks.Count
        If Workbooks(i).Name = "成績表.xls" Then
            MsgBox "檔案已開啟"
            Exit Sub '如果找到該檔案，退出過程
        End If
    Next
    MsgBox "檔案沒有開啟"
End Sub

• 工作表是否開啟判斷

'判斷開啟的工作表中是否含“一年級”，有則移動到第一個位置，否則在第一個位置建立
Sub isShtOpen()
    Dim sht As Worksheet
    For Each sht In Worksheets
        If sht.Name = "一年級" Then
            sht.Move before:=Worksheets(1)
            'MsgBox "已經開啟"
            Exit Sub
        End If
    Next
    Worksheets.Add(before:=Worksheets(1)).Name = "一年級"
End Sub

另一種寫法：

'判斷開啟的工作表中是否含“一年級”，有則移動到第一個位置，否則在第一個位置建立

Sub isShtOpen()
    On Error Resume Next
    If Worksheets("一年級") Is Nothing Then
        Worksheets.Add(before:=Worksheets(1)).Name = "一年級"
    Else
        Worksheet("一年級").Move before:=Worksheets(1)
        'MsgBox "已經開啟"
    End If
End Sub

3、判斷工作簿是否存在

Sub isExistWb()
    '判斷本工作簿所在的資料夾中是否存在“員工花名冊.xls”
    Dim fil As String
    fil = ThisWorkbook.Path & "\員工花名冊.xls"
    If Len(Dir(fil)) > 0 Then
        MsgBox "工作簿已經存在"
    Else
        MsgBox "工作簿不存在"
    End If
End Sub

4、向未開啟的工作簿中錄入資料

Sub WbInput()
    '在本工作簿所在的資料夾下“員工花名冊”裡新增一條記錄
    Dim wb As String, xrow As Integer, arr
    wb = ThisWorkbook.Path & "\員工花名冊.xls"
    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

5、隱藏活動工作表外的所有工作表

Sub ShtVisible()
    '隱藏活動工作表外的所有工作表
    Dim sht As Worksheet
    For Each sht In Worksheet
        If sht.Name <> ActiveSheet.Name Then
            sht.Visible = xlSheetVeryHidden '深度隱藏，不能通過“格式”選單顯示它
        End If
    Next
End Sub

6、批量新建工作表

Sub shtAdd()
    '一張成績表中儲存不同班級的資料，需要以班級名命名
    '根據C列的班級名新建不同的工作表
    Dim i As Integer, sht As Worksheet
    i = 2
    Set sht = Worksheets("成績表")
    Do While sht.Cells(i, "C") <> ""
        Worksheets.Add after:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = sht.Cells(i, "C").Value
        i = i + 1
    Loop
End Sub

7、批量對資料分類

Sub fenLei()
    '把成績按班級分到各個工作表中
    Dim i As Long, bj As String, rng As Range
    i = 2
    bj = Cells(i, "C").Value
    Do While bj <> ""
        '將分表中A列第一個空單元格賦給rng
        Set rng = Worksheets(bj).Range("A65536").End(xlUp).Offset(1, 0)
        Cells(i, "A").Resize(1, 7).Copy rng '將記錄賦值到對應的工作表中
        i = i + 1
        bj = Cells(i, "C").Value
    Loop
End Sub

清除工作表內容

Sub shtClear()
    Dim sht As Worksheet
    For Each sht In Worksheets
        If sht.Name <> "成績表" Then
            sht.Range("A2:G65536").ClearContents
        End If
    Next
End Sub

8、將工作表儲存為新工作簿

Sub SaveToFile()
    '把各個工作表以單獨的工作簿檔案儲存在本工作簿所在的資料夾下的“班級成績表”資料夾下
    Application.ScreenUpdating = False '關閉螢幕更新
    Dim folder As String
    folder = ThisWorkbook.Path & "\班級成績表"
    '如果資料夾不存在，則新建資料夾
    If Len(Dir(folder, vbDirectory)) = 0 Then mkdir folder
    Dim sht As Worksheet
    For Each sht In Worksheets
        sht.Copy
        ActiveWorkbook.SaveAs folder & "\" & sht.Name & ".xlsx"
        ActiveWorkbook.Close
    Next
    Application.ScreenUpdating = True
End Sub

換種寫法：

Sub 自動拆分工作表()
'
' 自動拆分工作表 巨集
'
' 快捷鍵: Ctrl+m
'
    '把各個工作表以單獨的工作簿檔案儲存在本工作簿所在的資料夾下的“拆分工作簿”資料夾下
    Application.ScreenUpdating = False '關閉螢幕更新
    Dim folder As String
    folder = Application.ActiveWorkbook.Path & "\拆分工作簿"
    'folder = ThisWorkbook.Path & "\拆分工作簿"
    '如果資料夾不存在，則新建資料夾
    If Len(Dir(folder, vbDirectory)) = 0 Then MkDir folder
    Dim sht As Worksheet
    For Each sht In Worksheets
        sht.Copy
        ActiveWorkbook.SaveAs folder & "\" & sht.Name & ".xlsx"
        ActiveWorkbook.Close
    Next
    Application.ScreenUpdating = True    
    
End Sub

9、快速合併多表資料

Sub HeBing()
    '把各班級成績表合併到“總成績”工作表中
    Rows("2:25536").Clear '刪除原有記錄
    Dim sht As Worksheet, xrow As Integer, rng As Range
    For Each sht In Worksheets  '遍歷工作簿中所有工作表
        If sht.Name <> ActiveSheet.Name Then
            Set rng = Range("A65536").End(xlUp).Offset(1, 0) '獲得A列第一個空單元格
            xrow = sht.Range("A1").CurrentRegion.Rows.Count - 1 '記錄分表中記錄條數
            sht.Range("A2").Resize(xrow, 7).Copy rng '貼上記錄到彙總表
        End If
    Next
End Sub

10、彙總同文件夾下多個工作簿數

Sub HzwWb()
    '把目前下各個工作簿的資訊彙總到同文件夾下的另一個工作簿的同一張工作表裡
    Dim r, c As Long
    r = 1 '表頭的行數
    c = 8 '表頭的列數
    Range(Cells(r + 1, "A"), Cells(65536, c)).ClearContents '清空彙總表中原資料
    Application.ScreenUpdating = False '關閉螢幕更新
    Dim FileName As String, wb As Workbook, sht As Worksheet, Erow As Long, fn As String, arr As Variant
    FileName = Dir(ThisWorkbook.Path & "\" & "*.xlsx")
    Do While FileName <> ""
        If FileName <> ThisWorkbook.Name Then '判斷檔案是否是本工作簿
            Erow = Range("A1").CurrentRegion.Rows.Count + 1 '取得彙總表中第一條空行行號
            fn = ThisWorkbook.Path & "\" & FileName
            Set wb = GetObject(fn) '將fn代表的工作簿物件賦給變數
            Set sht = wb.Worksheets(1) '彙總的是第一張工作表
            '將資料表中的記錄儲存在arr數組裡
            arr = sht.Range(sht.Cells(r + 1, "A"), sht.Cells(65536, "B").End(xlUp).Offset(0, 8))
            '將陣列arr中的資料寫入工作表
            Cells(Erow, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
            wb.Close False
        End If
        FileName = Dir '用Dir函式取得其他檔名，並賦值給變數
    Loop
    Application.ScreenUpdating = True '恢復螢幕更新
End Sub

11、為工作表建立目錄

Sub mkdir()
    '為工作簿中所有工作表建立目錄
    Rows("2:65536").ClearContents
    Dim sht As Worksheet, irow As Integer
    irow = 2
    For Each sht In Worksheets '遍歷工作表
        Cells(irow, "A").Value = irow - 1 '寫入序號
        '寫入工作表名，並建立超連結
        ActiveSheet.Hyperlinks.Add anchor:=Cells(irow, "B"), Address:="", _
            SubAddress:="'" & sht.Name & "'!A1", TextToDisplay:=sht.Name
            irow = irows + 1 '行號加1
    Next
End Sub