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