Excel vba：批量生成超链接，添加边框，移动sheet等 - flysong

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