[已解决]求大师给一个文件中几十上百张表格弄了目录并能反查定位

flytoday

已将病毒杀了0.rar (63.11 KB, 下载次数: 6)

2013-9-11 12:29 上传

点击文件名下载附件




麻烦路过的大师了谢谢~~~

最佳答案

月排行榜 / 总排行榜

redsheep

2013-9-11 12:49

网上有现成的生成目录的代码
我给你转一个  有自己的需求的话自己修改

1. Sub mulu()
   
2. On Error GoTo Tuichu
   
3. Dim i As Integer
   
4. Dim ShtCount As Integer
   
5. Dim SelectionCell As Range
   
6. 
   
7. ShtCount = Worksheets.Count
   
8. If ShtCount = 0 Or ShtCount = 1 Then Exit Sub
   
9. Application.ScreenUpdating = False
   
10. For i = 1 To ShtCount
    
11. If Sheets(i).Name = "目录" Then
    
12. Sheets("目录").Move Before:=Sheets(1)
    
13. End If
    
14. Next i
    
15. If Sheets(1).Name <> "目录" Then
    
16. ShtCount = ShtCount + 1
    
17. Sheets(1).Select
    
18. Sheets.Add
    
19. Sheets(1).Name = "目录"
    
20. End If
    
21. Sheets("目录").Select
    
22. Columns("B:B").Delete Shift:=xlToLeft
    
23. Application.StatusBar = "正在生成目录…………请等待！"
    
24. For i = 2 To ShtCount
    
25. ActiveSheet.Hyperlinks.Add Anchor:=Worksheets("目录").Cells(i, 2), Address:="", SubAddress:= _
    
26. "'" & Sheets(i).Name & "'!R1C1", TextToDisplay:=Sheets(i).Name
    
27. Next
    
28. Sheets("目录").Select
    
29. Columns("B:B").AutoFit
    
30. Cells(1, 2) = "目录"
    
31. Set SelectionCell = Worksheets("目录").Range("B1")
    
32. With SelectionCell
    
33. .HorizontalAlignment = xlDistributed
    
34. .VerticalAlignment = xlCenter
    
35. .AddIndent = True
    
36. .Font.Bold = True
    
37. .Interior.ColorIndex = 34
    
38. End With
    
39. Application.StatusBar = False
    
40. Application.ScreenUpdating = True
    
41. Tuichu:
    
42. End Sub
    
43. 
    

复制代码

跳转到最佳答案楼层

zhp3

怎么这样？

ppp710715

文件有病毒，无法打开。

flytoday

大师我没装你这个杀毒但是我的电脑显示无毒真晕~

我心飞翔410

zhp3 发表于 2013-9-11 11:31
怎么这样？

中招啦 还好我没下

flytoday

用本站那个宏杀了下还有是的晕~~

flytoday

更新了~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

redsheep

网上有现成的生成目录的代码
我给你转一个  有自己的需求的话自己修改

1. Sub mulu()
   
2. On Error GoTo Tuichu
   
3. Dim i As Integer
   
4. Dim ShtCount As Integer
   
5. Dim SelectionCell As Range
   
6. 
   
7. ShtCount = Worksheets.Count
   
8. If ShtCount = 0 Or ShtCount = 1 Then Exit Sub
   
9. Application.ScreenUpdating = False
   
10. For i = 1 To ShtCount
    
11. If Sheets(i).Name = "目录" Then
    
12. Sheets("目录").Move Before:=Sheets(1)
    
13. End If
    
14. Next i
    
15. If Sheets(1).Name <> "目录" Then
    
16. ShtCount = ShtCount + 1
    
17. Sheets(1).Select
    
18. Sheets.Add
    
19. Sheets(1).Name = "目录"
    
20. End If
    
21. Sheets("目录").Select
    
22. Columns("B:B").Delete Shift:=xlToLeft
    
23. Application.StatusBar = "正在生成目录…………请等待！"
    
24. For i = 2 To ShtCount
    
25. ActiveSheet.Hyperlinks.Add Anchor:=Worksheets("目录").Cells(i, 2), Address:="", SubAddress:= _
    
26. "'" & Sheets(i).Name & "'!R1C1", TextToDisplay:=Sheets(i).Name
    
27. Next
    
28. Sheets("目录").Select
    
29. Columns("B:B").AutoFit
    
30. Cells(1, 2) = "目录"
    
31. Set SelectionCell = Worksheets("目录").Range("B1")
    
32. With SelectionCell
    
33. .HorizontalAlignment = xlDistributed
    
34. .VerticalAlignment = xlCenter
    
35. .AddIndent = True
    
36. .Font.Bold = True
    
37. .Interior.ColorIndex = 34
    
38. End With
    
39. Application.StatusBar = False
    
40. Application.ScreenUpdating = True
    
41. Tuichu:
    
42. End Sub
    
43. 
    

复制代码

flytoday

大师我不会改麻烦改改谢谢~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

zhp3

每个表建立单独的工作表建立目录。
取工作表名.zip (19.78 KB, 下载次数: 14)

2013-9-11 15:22 上传

点击文件名下载附件