背景：
- VBA（Visual Basic for Applications）是Visual Basic的一種宏語(yǔ)言址愿，是在其桌面應(yīng)用程序中執(zhí)行通用的自動(dòng)化(OLE)任務(wù)的編程語(yǔ)言。主要能用來(lái)擴(kuò)展Windows的應(yīng)用程序功能拗慨，特別是Microsoft Office軟件宣肚。它也可說(shuō)是一種應(yīng)用程式視覺(jué)化的 Basic 腳本刷后。VB（Visual Basic）是微軟一種開(kāi)發(fā)語(yǔ)言闷游，有自己的開(kāi)發(fā)IDE镊尺，可以用來(lái)設(shè)計(jì)創(chuàng)建和編寫(xiě)程序并生成標(biāo)準(zhǔn)的Exe執(zhí)行程序
- 工作中有時(shí)候需要將很多表格合并到一個(gè)excel表格里面悲立，分成不同的sheet進(jìn)行展示。如果sheet數(shù)量太多档冬，就不太方便找到自己想要的表格膘茎。如果很方便創(chuàng)建一個(gè)excel目錄頁(yè)，就很方便跳轉(zhuǎn)查閱了酷誓。
- 對(duì)每個(gè)Sheet里面有一些關(guān)鍵的指標(biāo)進(jìn)行匯總披坏，如果沒(méi)變化，就不需要我們點(diǎn)擊進(jìn)去查看了盐数，減少我們工作量棒拂。如前后兩次輸出的表格差異的條目number(Old/New)，
- VBA 對(duì)應(yīng)Excel操作非常有優(yōu)勢(shì)；超鏈接跳轉(zhuǎn)功能在SAS里面操作可以實(shí)現(xiàn)帚屉，但跳轉(zhuǎn)功能限制于文件所處絕對(duì)路徑谜诫；
目的：快速生成目錄頁(yè)，實(shí)現(xiàn)跳轉(zhuǎn)功能攻旦，并統(tǒng)計(jì)關(guān)鍵的指標(biāo)喻旷；
VBA小程序書(shū)寫(xiě)指南
1. Click "file", "options", "Customize Ribbon", and check "developer"
image.png
2. Return to the main interface, click "developer", click "macro security", and change the settings as follows
image.png
3.創(chuàng)建模塊
image.png
image.png
3.按照VBA語(yǔ)法寫(xiě)腳本
image.png
4.打開(kāi)調(diào)試及標(biāo)記工具
print窗口及批量注釋
image.png
image.png
入門(mén)例子
1.MsgBox "這是我的第一個(gè)VBA程序"
Sub hello()
'1、第一個(gè)VBA程序
MsgBox "這是我的第一個(gè)VBA程序"
End Sub
2.Debug.Print "這是我的第二個(gè)VBA程序"
Sub hello()
'2牢屋、第二個(gè)VBA程序
Debug.Print "這是我的第二個(gè)VBA程序"
End Sub
3.Cells(1, 1) = "這是我的第三個(gè)VBA程序"
Sub hello()
'3掰邢、第三個(gè)VBA程序
Cells(1, 1) = "這是我的第三個(gè)VBA程序"
End Sub
添加目錄頁(yè)實(shí)現(xiàn)跳轉(zhuǎn)功能思路
- 1.判斷summary_tab是否存在；
- 2.寫(xiě)入標(biāo)題設(shè)置格式（顏色及寬度高度）伟阔；
- 3.變量每個(gè)表格獲取NewFlag單元格坐標(biāo)辣之；
- 4.添加New,Old的數(shù)目；
- 5.total number填充皱炉；
VBA腳本代碼如下：
Sub Catalog_Page()
'Part1: 判斷是否存在此Sheet
Dim sh As Worksheet
exist = 0
For Each sh In Worksheets
If sh.Name = "Catalog_Page" Then
exist = 1
Debug.Print "whether table is "; exist
End If
Next sh
If exist = 0 Then
Sheets.Add before:=Sheets(1)
ActiveSheet.Name = "Catalog_Page"
Else
ThisWorkbook.Worksheets("Catalog_Page").Select
If ThisWorkbook.Sheets("Catalog_Page").UsedRange.Rows.Count > 1 Then
ThisWorkbook.Sheets("Catalog_Page").Rows("2:" & ThisWorkbook.Sheets("Catalog_Page").UsedRange.Rows.Count).ClearContents
End If
'Part2: 寫(xiě)入標(biāo)題內(nèi)容
'列寬行高
With Sheets("Catalog_Page")
.Columns.ColumnWidth = 20
.Rows.RowHeight = .StandardHeight
End With
'添加標(biāo)題Listing Name怀估，Total Number，New合搅， Old
Cells(1, 1) = "Listing Name"
Cells(1, 2) = "Total Number"
Cells(1, 3) = "New"
Cells(1, 4) = "Old"
'顏色
Range("A1:D1").Interior.Color = RGB(220, 230, 241)
Debug.Print "part2"
'Part3: 遍歷每個(gè)sheet
Dim x As Long
x = 3
For x = 2 To Sheets.Count '從第2頁(yè)開(kāi)始
'part3.1 創(chuàng)建超鏈接
Sheets(1).Hyperlinks.Add Anchor:=Cells(0 + x, 1), Address:=ActiveWorkbook.Name, SubAddress:=Sheets(x).Name & "!A1", TextToDisplay:=Sheets(x).Name
'從sheet3的地14行第四列開(kāi)始添加超鏈接多搀，地址是當(dāng)前當(dāng)前工作薄的sheet（X）的名字，顯示為sheet（X）的名字
'part3.2 計(jì)算newflag location
rownum = WorksheetFunction.CountA(Worksheets(x).Columns("a:a")) '去除空行
a = Worksheets(x).UsedRange.Rows.Count
b = Worksheets(x).UsedRange.Columns.Count
newflag_i = 0
newflag_j = 0
For i = 6 To 8
For j = 1 To b
If Worksheets(x).Cells(i, j).Value = "NewFlag" Then
newflag_i = i
newflag_j = j
End If
Next j
Next i
'MsgBox a
Debug.Print Worksheets(x).Name; rownum; a; b
Debug.Print Worksheets(x).Name; " newflag "; newflag_i; newflag_j
'part3.3 計(jì)算Flag=New or Old number
number_new = 0
number_old = 0
If newflag_j > 0 Then
For i = newflag_i To a
' Debug.Print Cells(i, newflag_j)
' Debug.Print "cell Value== -"; Cells(i, newflag_j).Value; "- %%%%%%%%%%%%%%%%%"
'
If Worksheets(x).Cells(i, newflag_j) = "New" Then
number_new = number_new + 1
End If
If Worksheets(x).Cells(i, newflag_j) = "Old" Then
number_old = number_old + 1
' Debug.Print "cell"; Cells(7, j).Value; "ok"
End If
Next i
End If
'' Debug.Print "part3.3 計(jì)算Flag=New or Old number"; number_new
Debug.Print Worksheets(x).Name; " part3.3 計(jì)算Flag=New or Old number "; "New= "; number_new; "Old="; number_old, "*****************"
Sheets("Catalog_Page").Cells(x, 3) = number_new
Sheets("Catalog_Page").Cells(x, 4) = number_old
'part3.4 計(jì)算total number
Sheets("Catalog_Page").Cells(x, 2) = number_new + number_old
' Sheets("Catalog_Page").Cells(x, 5) = rownum - newflag_i
Next x
End Sub
運(yùn)行宏程序效果
image.png
參考
https://blog.csdn.net/zutsoft/article/details/45727609
https://zhuanlan.zhihu.com/p/115991177
https://blog.csdn.net/weixin_44412679/article/details/108249353
https://www.cnblogs.com/russellluo/archive/2011/10/11/2207925.html
