【VBA】对Excel表格添加目录页&实现点击跳转

2022-11-13 本文已影响0人 caokai001

背景：

VBA（Visual Basic for Applications）是Visual Basic的一种宏语言，是在其桌面应用程序中执行通用的自动化(OLE)任务的编程语言。主要能用来扩展Windows的应用程序功能，特别是Microsoft Office软件。它也可说是一种应用程式视觉化的 Basic 脚本。VB（Visual Basic）是微软一种开发语言，有自己的开发IDE，可以用来设计创建和编写程序并生成标准的Exe执行程序

工作中有时候需要将很多表格合并到一个excel表格里面，分成不同的sheet进行展示。如果sheet数量太多，就不太方便找到自己想要的表格。如果很方便创建一个excel目录页，就很方便跳转查阅了。
对每个Sheet里面有一些关键的指标进行汇总，如果没变化，就不需要我们点击进去查看了，减少我们工作量。如前后两次输出的表格差异的条目number(Old/New)，

VBA 对应Excel操作非常有优势；超链接跳转功能在SAS里面操作可以实现，但跳转功能限制于文件所处绝对路径；

目的：快速生成目录页，实现跳转功能，并统计关键的指标；

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.创建模块

image.png

3.按照VBA语法写脚本

image.png

4.打开调试及标记工具

print窗口及批量注释

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

添加目录页实现跳转功能思路

1.判断summary_tab是否存在；
2.写入标题设置格式（颜色及宽度高度）；
3.变量每个表格获取NewFlag单元格坐标；
4.添加New,Old的数目；
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: 写入标题内容
    '列宽行高
    With Sheets("Catalog_Page")
      .Columns.ColumnWidth = 20
      .Rows.RowHeight = .StandardHeight
    End With

    '添加标题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 创建超链接
        Sheets(1).Hyperlinks.Add Anchor:=Cells(0 + x, 1), Address:=ActiveWorkbook.Name, SubAddress:=Sheets(x).Name & "!A1", TextToDisplay:=Sheets(x).Name
        '从sheet3的地14行第四列开始添加超链接，地址是当前当前工作薄的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