用EXCEL VBA程式，各自單獨建立分公司分頁表，並增設超連結方便索引

因業務需要，有5個分公司(甲~戊)業務要管，想用EXCEL表，

提供給各單位填報回傳資料進行管理，並以分公司名稱 各自單獨建立1個工作表，

同時增設超連結方便索引 。

EXCEL表已先建立好各分公司名稱於A欄位中，如下:
         A
1  分公司名稱  
2  甲分公司
3  乙分公司
4  丙分公司
5  丁分公司
6  戊分公司


藉由AI(ChatGPT)協助建立各自建立分公司獨立分頁，並提供超連結設置，方便檢索

PROMPT提示訊息下法:
EXCEL表中，自A2儲存格起,有多個分公司 放於A欄位中,請提供VBA程式，幫忙建立 分公司分頁 ，並且設置超連結，方便檢索


Sub CreateCompanySheets()
    Dim ws As Worksheet
    Dim company As Range
    
    ' 在第一個工作表中建立一個名為 「 各分公司索引清單」的分頁
    Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws.Name = "各分公司索引清單"
    
    ' 在「 各分公司索引清單」分頁中設置標題
    ws.Range("A1").Value = "分公司"
    
    ' 從A2儲存格起，逐一遍歷分公司名稱
    For Each company In ThisWorkbook.Sheets(1).Range("A2:A" & ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row)
        ' 檢查分公司分頁是否已存在
        If Not SheetExists(company.Value) Then
            ' 如果分公司分頁不存在，則建立一個新的分頁
            ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = company.Value
        End If
        
        ' 在「 各分公司索引清單」分頁中設置超連結
        ws.Hyperlinks.Add Anchor:=ws.Range("A" & ws.Cells(Rows.Count, 1).End(xlUp).Row + 1), _
                          Address:="", _
                          SubAddress:="'" & company.Value & "'!A1", _
                          TextToDisplay:=company.Value
    Next company
    
    ' 回到  第一個工作表
    ThisWorkbook.Sheets(1).Activate

End Sub

Function SheetExists(sheetName As String) As Boolean
    Dim ws As Worksheet
    
    SheetExists = False
    For Each ws In ThisWorkbook.Sheets
        If ws.Name = sheetName Then
            SheetExists = True
            Exit Function
        End If
    Next ws
End Function


請按照以下步驟使用此程式：

STEP1:開啟您的Excel檔案。
STEP2:按下Alt + F11進入VBA編輯器。
STEP3:在VBA編輯器中，插入一個新的模組Module。
STEP4:將上述VBA程式碼，複製並貼上到新的模組Module中。
STEP5:在VBA編輯器中，按下F5運行程式。

VBA程式，將會在您的Excel檔案中建立一個名為「 各分公司索引清單」的分頁，並在該分頁中列出 所有分公司的超連結。點擊超連結即可跳轉到相對應的分公司 分頁 。