Excel vba：批量生成超連接，添加邊框，移動sheet等

 

Excel vba 操做

批量生成sheet目錄並添加超連接

 

Sub Add_Sheets_Link() 'Worksheets(5)爲清單目錄頁
    '在sheet頁上生成sheet頁名字並超連接
    For i = 1 To ThisWorkbook.Worksheets.Count Worksheets(5).Cells(i + 1, 10).Value = Worksheets(i).Name Worksheets(5).Hyperlinks.Add Anchor:=Worksheets(5).Cells(i + 1, 10), Address:="", SubAddress:= _ Worksheets(5).Cells(i + 1, 10) & "!" & "A1", TextToDisplay:=Worksheets(5).Cells(i + 1, 10) & "!" & "A1"
    
    Next
    
    '在每一個內容sheet上添加超連接返回目錄
    For i = 6 To ThisWorkbook.Worksheets.Count Worksheets(i).Hyperlinks.Add Anchor:=Worksheets(i).Cells(1, 6), Address:="", SubAddress:= _ "Sheet1!A1", TextToDisplay:="返回清單"
    Next
    
    '在（1,1單元格）超連接返回到 接口清單sheet頁
    For i = 6 To ThisWorkbook.Worksheets.Count 'Cells(i + 1, 2).Value = Worksheets(i).Name
    Worksheets(i).Hyperlinks.Add Anchor:=Worksheets(i).Cells(1, 1), Address:="", SubAddress:= _ Worksheets(5).Name & "!" & "A1"
            'Worksheets(3).Cells(i + 1, 2).Value = Worksheets(i).Name
    Next

End Sub

View Code

 

區域全選，添加邊框

 

'選中區域添加邊框
Sub region_select() '     For i = 6 To ThisWorkbook.Worksheets.Count Worksheets(i).UsedRange.Borders.LineStyle = xlContinuous '加邊框線
        Worksheets(i).Range("A1:K1").Borders.LineStyle = xlNone '取消邊框線

        '方法2 區域全選
        'Worksheets(i).UsedRange.Select 錯誤 '只有當前活動頁才能選中
        'Worksheets(i).Activate
        'ActiveCell.CurrentRegion.Select ' 實現區域全選
        'rng_address = Selection.Address ' 返回該區域地址
        'Selection.Borders.LineStyle = xlContinuous '加邊框線
        'Worksheets(i).Range("A1:K1").Borders.LineStyle = xlNone '取消邊框線

    Next

End Sub

View Code

 

命名sheet頁，拼接字符串

'第9 ，10列，即 I,J列 分別爲代碼和名稱
Sub RenameSheet_AddBackBoder() For i = 6 To ThisWorkbook.Worksheets.Count Worksheets(i).UsedRange.Borders.LineStyle = xlContinuous '加邊框線
        Worksheets(i).Range("A1:K1").Borders.LineStyle = xlNone '取消邊框線
        
        '第9 ，10列，分別爲代碼和名稱
        tcname = Worksheets(5).Cells(i - 5, 10).Value tccode = "(" & Worksheets(5).Cells(i - 5, 9).Value & ")" Worksheets(i).Cells(1, 1).Value = tcname & tccode ' 文字格式： 名稱（代碼）
        Worksheets(i).Name = tcname Next

End Sub

View Code

 

定義名稱添加超連接

Sub AddNames_Hyper() '定義名稱添加超連接
  For i = 6 To ThisWorkbook.Worksheets.Count ActiveWorkbook.Names.Add Name:=Worksheets(i).Name, RefersToR1C1:="=" & Worksheets(i).Name & "!R1C1"
    
    'Worksheets(5).Hyperlinks.Add Anchor:=Worksheets(5).Cells(i - 5, 10), Address:="", SubAddress:= _
            'Worksheets(5).Cells(i - 5, 10) & "!" & "A1"
 Worksheets(5).Hyperlinks.Add Anchor:=Worksheets(5).Cells(i - 5, 10), Address:="", SubAddress:= _ Worksheets(i).Name Next

View Code

sheet佈局排序，按某一列內容排序

Sub SortByCol() For i = 6 To ThisWorkbook.Worksheets.Count sheet_name = Trim(Worksheets(i).Name) Worksheets(i).Name = sheet_name Next
    
    For i = 6 To ThisWorkbook.Worksheets.Count '第10列爲順序列，單元格內容爲sheet頁名稱
        order_name = Trim(Worksheets(5).Cells(i - 5, 10).Value) Worksheets(5).Cells(i - 5, 10) = order_name Sheets(order_name).Move after:=Sheets(i - 1) Next

End Sub

View Code