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

相关文章推荐

茫然的筷子 · vba判断一个字符串是否为全数字 - CSDN文库· 1 月前 ·

坏坏的海龟 · VBA) (Property Let ...· 1 月前 ·

另类的毛衣 · sql将select结果作为临时表 - ...· 4 月前 ·

俊逸的冲锋衣 · 解決可為 Null 的警告 - C# | ...· 12 月前 ·

细心的南瓜 · 都什么年代了，还有人在 MySQL ...· 1 年前 ·

很酷的钢笔 · 急！ActiveMQ集群启动失败 No ...· 1 年前 ·

很拉风的丝瓜 · 达·芬奇逝世500年 | ...· 1 年前 ·

' 在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 " ' 在每个内容sheet上添加超链接返回目录 For i = 6 To ThisWorkbook.Worksheets.Count Worksheets(i).Hyperlinks.Add Anchor: =Worksheets(i).Cells( 1 , 6 ), Address:= "" , SubAddress:= _ " Sheet1!A1 " , TextToDisplay:= " 返回清单 " ' 在（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 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 '取消边框线
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
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
View Code
sheet布局排序，按某一列内容排序
Sub SortByCol()
    For i = 6 To ThisWorkbook.Worksheets.Count
        sheet_name = Trim(Worksheets(i).Name)
        Worksheets(i).Name = sheet_name         
    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)        
End Sub
View Code