见附件

huchuanxing

本工作簿标准模块里有一段建立工作表目录和键接的VBA程序。程序运行时先会清除"目录"工作表，然后再重新建立目录和链接，但由于清除“目录”工作表时没有清除原先建立的“返回目录”的键接，故每运行一次程序就会増加一个“返回目录”的键接，现在我想请求帮忙解决的问题是：当程序运行清除目录工作表时，添加一段代码，把原先建立的键接一并清除。然后再重新建立目录和键接。

su45

1. Sub 提取班级表名并建立链接()
   
2. '建立目录
   
3.     Dim 行%, 列%, x%, i%, j%
   
4.     Application.ScreenUpdating = False
   
5.     With Sheets("目录")
   
6.         .Cells.Delete
   
7.         For x = 1 To Sheets.Count
   
8.             行 = ((x - 1) Mod 20) + 1
   
9.             列 = (Int((x - 1) / 20) + 1) * 2 - 1
   
10.             .Cells(行, 列) = "=hyperlink(""#'" & Sheets(x).Name & "'!A1"",""" & Sheets(x).Name & """)"
    
11.         Next x
    
12.         .Rows().RowHeight = 18
    
13.         .Columns().ColumnWidth = 18
    
14.     End With
    
15.     Application.ScreenUpdating = True
    
16. End Sub
    

复制代码

fjmxwrs

工作表事件和单元格事件相结合，非超链接，全部代码完成

huchuanxing

fjmxwrs 发表于 2016-11-8 18:27
工作表事件和单元格事件相结合，非超链接，全部代码完成

可能是误解的我的意思，您的代码不符合我的要求：
1、“目录”工作表是在运行VBA代码时自选自行创建的。
2、“返回目录”不能固定在L1单元格位置，因为其它工作簿也要用这个代码，所以要根据工作簿中的工作表使用列数的不同，把“返回目录“放在工作表已使用的最后一列的下一列的第一行位置。

huchuanxing

su45 发表于 2016-11-8 17:15

目录工作表不是先就存在的，而是在运行建立工作表和链接VBA代码时自动创建的。其次是在除目录工作表外的其它工作表中要姐返回目录的一个键接，这个键接的位置要放在该表已使用列数的最后一列的下一列的第一行。

su45

这个目录表保留不好吗？

huchuanxing

su45 发表于 2016-11-8 22:23
这个目录表保留不好吗？

因为这个代码是要放在其它工作簿里的，以便提取工作表名和建立链接，如果运行代码时自动创建一个目录工作表，不是比人工先创建一个名为“目录”工作表理更方便吗？

su45

1. Sub 提取班级表名并建立链接()
   
2. 
   
3. '建立目录
   
4.     Dim 行%, 列%, x%, i%, j%
   
5.     On Error Resume Next
   
6.     Application.ScreenUpdating = False
   
7.     Application.DisplayAlerts = False
   
8.     Sheets("目录").Delete
   
9.     Application.DisplayAlerts = True
   
10.     Sheets.Add(before:=Sheets(1)).Name = "目录"
    
11.     For x = 1 To Sheets.Count
    
12.         行 = ((x - 1) Mod 20) + 1
    
13.         列 = (Int((x - 1) / 20) + 1) * 2 - 1
    
14.         Cells(行, 列) = "=hyperlink(""#'" & Sheets(x).Name & "'!A1"",""" & Sheets(x).Name & """)"
    
15.     Next x
    
16.     Application.ScreenUpdating = True
    
17. 
    
18.     ' 建立返回目录链接
    
19.     For i = 2 To Sheets.Count
    
20.         j = Sheets(i).UsedRange.Columns.Count  '获取工作表使用的列数
    
21.         If Cells(1, j).Text <> "返回目录" Then
    
22.             Sheets(i).Hyperlinks.Add Anchor:=Sheets(i).Cells(1, j + 1), Address:="", SubAddress:= _
    
23.                                  "目录!A1", TextToDisplay:="返回目录"
    
24.         End If
    
25.     Next
    
26.     Sheets("目录").Rows().RowHeight = 18
    
27.     Sheets("目录").Columns().ColumnWidth = 18
    
28. End Sub
    

复制代码

huchuanxing

su45 发表于 2016-11-8 23:01

问题没解决。运行代码时，如果工作簿里有目录工作表则先删除该工作表，这个没问题，但并没有删除其它工作表里先前建立的“返回目录”链接，所以你的代码里还存在每运行一次都会在非目录工作表之外的其它工作表新增加一个“返回目录”的链接。

su45

搞错了，还认为要填加链接，改了下：

1. Sub 提取班级表名并建立链接()
   
2. 
   
3. '建立目录
   
4.     Dim 行%, 列%, x%, i%, j%
   
5.     On Error Resume Next
   
6.     Application.ScreenUpdating = False
   
7.     Application.DisplayAlerts = False
   
8.     Sheets("目录").Delete
   
9.     Application.DisplayAlerts = True
   
10.     Sheets.Add(before:=Sheets(1)).Name = "目录"
    
11.     For x = 1 To Sheets.Count
    
12.         行 = ((x - 1) Mod 20) + 1
    
13.         列 = (Int((x - 1) / 20) + 1) * 2 - 1
    
14.         Cells(行, 列) = "=hyperlink(""#'" & Sheets(x).Name & "'!A1"",""" & Sheets(x).Name & """)"
    
15.     Next x
    
16.     Application.ScreenUpdating = True
    
17. 
    
18.     ' 建立返回目录链接
    
19.     For i = 2 To Sheets.Count
    
20.         With Sheets(i)
    
21.             co = .Cells(7, Columns.Count).End(1).Column
    
22.             j = .UsedRange.Columns.Count  '获取工作表使用的列数
    
23.             If j > co Then
    
24.                 Range(.Cells(1, co + 1), .Cells(1, j)).ClearContents
    
25.             End If
    
26.         End With
    
27.     Next
    
28.     Sheets("目录").Rows().RowHeight = 18
    
29.     Sheets("目录").Columns().ColumnWidth = 18
    
30. End Sub
    

复制代码