背景：

• VBA（Visual Basic for Applications）是Visual Basic的一種宏語言，是在其桌面應(yīng)用程序中執(zhí)行通用的自動化(OLE)任務(wù)的編程語言。主要能用來擴展Windows的應(yīng)用程序功能，特別是Microsoft Office軟件。它也可說是一種應(yīng)用程式視覺化的 Basic 腳本。VB（Visual Basic）是微軟一種開發(fā)語言，有自己的開發(fā)IDE，可以用來設(shè)計創(chuàng)建和編寫程序并生成標(biāo)準(zhǔn)的Exe執(zhí)行程序

• 工作中有時候需要將很多表格合并到一個excel表格里面，分成不同的sheet進行展示。如果sheet數(shù)量太多，就不太方便找到自己想要的表格。如果很方便創(chuàng)建一個excel目錄頁，就很方便跳轉(zhuǎn)查閱了。
• 對每個Sheet里面有一些關(guān)鍵的指標(biāo)進行匯總，如果沒變化，就不需要我們點擊進去查看了，減少我們工作量。如前后兩次輸出的表格差異的條目number(Old/New)，

• VBA 對應(yīng)Excel操作非常有優(yōu)勢；超鏈接跳轉(zhuǎn)功能在SAS里面操作可以實現(xiàn)，但跳轉(zhuǎn)功能限制于文件所處絕對路徑；

目的：快速生成目錄頁，實現(xiàn)跳轉(zhuǎn)功能，并統(tǒng)計關(guān)鍵的指標(biāo)；

VBA小程序書寫指南

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語法寫腳本

image.png

4.打開調(diào)試及標(biāo)記工具

print窗口及批量注釋

image.png

image.png

入門例子

1.MsgBox "這是我的第一個VBA程序"

Sub hello()

    '1、第一個VBA程序

    MsgBox "這是我的第一個VBA程序"

End Sub

2.Debug.Print "這是我的第二個VBA程序"

Sub hello()

    '2、第二個VBA程序

    Debug.Print "這是我的第二個VBA程序"

End Sub

3.Cells(1, 1) = "這是我的第三個VBA程序"

Sub hello()

    '3、第三個VBA程序

    Cells(1, 1) = "這是我的第三個VBA程序"

End Sub

添加目錄頁實現(xiàn)跳轉(zhuǎn)功能思路

• 1.判斷summary_tab是否存在；
• 2.寫入標(biāo)題設(shè)置格式（顏色及寬度高度）；
• 3.變量每個表格獲取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: 寫入標(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: 遍歷每個sheet
    Dim x As Long
    x = 3
    For x = 2 To Sheets.Count  '從第2頁開始

    '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行第四列開始添加超鏈接，地址是當(dāng)前當(dāng)前工作薄的sheet（X）的名字，顯示為sheet（X）的名字

       
                
    'part3.2 計算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 計算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 計算Flag=New or Old number"; number_new
     Debug.Print Worksheets(x).Name; "   part3.3 計算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 計算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

運行宏程序效果

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

批量注釋 http://www.dzwebs.net/5213.html

https://baike.baidu.com/item/VBA/1596798